condice.f

Go to the documentation of this file.

!                   ******************
                    SUBROUTINE condice
!                   ******************
!
     &( npoin,h,record,at,listin )
!
!***********************************************************************
! KHIONE    V7P3
!***********************************************************************
!
!brief    INITIALISES THE PHYSICAL PARAMETERS FOR ICE.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AT             |<->| TIME OF THE DATASET
!| H              |<->| WATER DEPTH
!| LISTIN         |-->| IF YES, INFORMATIONS PRINTED ON LISTING
!| NPOIN          |-->| NUMBER OF POINT IN THE GEOMETRY MESH
!| RECORD         |-->| TIME STEP OF THE DATASET
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_khione
      USE freezeup_khione, ONLY : melting_point
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      LOGICAL         , INTENT(IN)    :: LISTIN
      INTEGER         , INTENT(IN)    :: NPOIN
      INTEGER         , INTENT(INOUT) :: RECORD
      DOUBLE PRECISION, INTENT(INOUT) :: AT
      TYPE(bief_obj)  , INTENT(INOUT) :: H
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER TROUVE(maxvar), I
      trouve = 0
!
!-----------------------------------------------------------------------
!
!   ATMOSPHERIC HEAT FLUXES
!
!     PHCL: SOLAR RAD (FLUX) REACHING SURFACE, UNDER CLEAR SKY
      CALL os('X=C     ', x=phcl, c=0.d0 )
!     PHRI: SOLAR RAD (FLUX) REACHING SURFACE, UNDER CLOUDY SKY
      CALL os('X=C     ', x=phri, c=0.d0 )
!     PHPS: NET SOLAR RAD (FLUX) AFTER REFLECTION
      CALL os('X=C     ', x=phps, c=0.d0 )
!     PHIB: EFFECTIVE BACK RADIATION (OPEN WATER OR ICE)
      CALL os('X=C     ', x=phib, c=0.d0 )
!     PHIE: EVAPORATIVE HEAT TRANSFER
      CALL os('X=C     ', x=phie, c=0.d0 )
!     PHIH: CONVECTIVE HEAT TRANSFER
      CALL os('X=C     ', x=phih, c=0.d0 )
!     PHIP: HEAT TRANSFER DUE TO PRECIPITATION
      CALL os('X=C     ', x=phip, c=0.d0 )
!     PHIW: HEAT TRANSFER BETWEEN WATER AND ICE
      CALL os('X=C     ', x=phiw, c=0.d0 )
!     SUMPH: NET SUM OF ALL THERMAL FLUXES (WATER SURFACE)
      CALL os('X=C     ', x=sumph, c=0.d0 )
!     SUMPH: NET SUM OF ALL THERMAL FLUXES (ICE COVER)
      CALL os('X=C     ', x=sumph_ice, c=0.d0 )
!
!-----------------------------------------------------------------------
!
!   FRAZIL ICE
!
!     FREEZING POINT OF WATER ( 0.oC BY DEFAULT )
      CALL os('X=C     ', x=tmelt, c=cst_tmelt )
!     FRAZIL ICE SEEDING RATE AT FREE SURFACE
      CALL os('X=C     ', x=seed, c=seedr )
!     MEAN TURBULENT KINETIC ENERGY FOR FRAZIL THERMAL GROWTH
      CALL os('X=C     ', x=kgm, c=0.d0 )
!     MEAN TURBULENT DISSIPATION RATE FOR FRAZIL THERMAL GROWTH
      CALL os('X=C     ', x=epsgm, c=0.d0 )
!     TURBULENT INTENSITY FOR FRAZIL THERMAL GROWTH
      CALL os('X=C     ', x=alpgm, c=0.d0 )
!     TURBULENT VISCOSITY FOR FRAZIL THERMAL GROWTH
      CALL os('X=C     ', x=nutgm, c=0.d0 )
      IF(thermal_budget) THEN
!       TOTAL NUMBER OF PARTICLE
        CALL os('X=C     ', x=ntot, c=0.d0 )
!       TOTAL CONCENTRATION OF FRAZIL
        CALL os('X=C     ', x=ctot, c=0.d0 )
      ENDIF
!
!-----------------------------------------------------------------------
!
!   ICE COVER
!
!     PROBABILITY OF FRAZIL DEPOSITION - OPEN WATER
      CALL os('X=C     ', x=theta0, c=0.d0 )
!     PROBABILITY OF FRAZIL DEPOSITION - ICE COVER
      CALL os('X=C     ', x=theta1, c=0.d0 )
!     RATE OF REENTRAINMENT OF SURFACE PER UNIT AREA
      CALL os('X=C     ', x=beta1, c=0.d0 )
!     SETTLING VELOCITY OF FRAZIL ICE IN THE TURBULENT FLOW
      CALL os('X=C     ', x=vbb, c=0.d0 )
!
!     MORE ICE THAN WATER AT SURFACE IF ANFEM(I) > 0.5
      CALL os('X=C     ', x=anfem, c=0.d0 )
!     TOTAL ICE THICKNESS
      CALL os('X=C     ', x=thifem, c=0.d0 )
!     SOLID ICE THICKNESS
      CALL os('X=C     ', x=thifems, c=0.d0 )
!     FRAZIL ICE THICKNESS
      CALL os('X=C     ', x=thifemf, c=0.d0 )
!     UNDERCOVER ICE THICKNESS
      CALL os('X=C     ', x=hun, c=0.d0 )
!
      CALL os('X=C     ', x=icestr, c=fice )
!
!     VERTICAL TURBULENT INTENSITY
      CALL os('X=C     ', x=vz, c=0.d0 )
!
!-----------------------------------------------------------------------
!
!     PREVIOUS ICE COVER COMPUTATION FILE
!
      IF( ice_files(icecov)%NAME.NE.' ' ) THEN
        CALL read_dataset(ice_files(icecov)%FMT,ice_files(icecov)%LU,
     &    varsor,npoin,record,at,textpr,trouve,
     &    alire,listin,record.EQ.0,maxvar)
      ENDIF
!
!-----------------------------------------------------------------------
!
!     INITIALISE ICE CHARACTERISATION (PRIME INTEGER)
      IF( trouve(21).EQ.1 ) THEN
        DO i = 1,npoin
          icetype%I(i) = int( icetype%R(i)+1.d-3 )
        ENDDO
      ELSE
        icetype%I = 1
      ENDIF
!
!-----------------------------------------------------------------------
!
!     ADJUST INITIAL WATER DEPTH AS A RESULT OF ICE COVER
!
      CALL os('X=X+CY  ', x=h, y=thifems, c=-rho_ice/ro0 )
      CALL os('X=X+CY  ', x=h, y=thifemf, c=-rho_ice/ro0 )
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE