point_khione.f

Go to the documentation of this file.

!                   ***********************
                    SUBROUTINE point_khione
!                   ***********************
!
     &( mesh,ielmx )
!
!***********************************************************************
! KHIONE   V7P3
!***********************************************************************
!
!brief    Memory allocation of structures, aliases, blocks...
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_special
      USE declarations_khione
!      USE DECLARATIONS_WAQTEL, ONLY: TDEW,VISBI
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,         INTENT(IN) :: IELMX
      TYPE(bief_mesh), INTENT(IN) :: MESH
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER NTR,I,J
      INTEGER CFG(2),IELM0,ILAST
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
      cfg(1) = 3
      cfg(2) = 1
      ielm0 = 10*(ielmx/10)
!
!     THERMAL BUDGET
      CALL bief_allvec(1,phcl,  'PHCL  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,phri,  'PHRI  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,phps,  'PHPS  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,phib,  'PHIB  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,phie,  'PHIE  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,phih,  'PHIH  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,phip,  'PHIP  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,phiw,  'PHIW  ',ielmx,1,1,mesh)
      CALL bief_allvec(1,sumph, 'SUMPH ',ielmx,1,1,mesh)
      CALL bief_allvec(1,sumph_ice, 'SUMPH_ICE ',ielmx,1,1,mesh)
!
!     FRAZIL ICE
      CALL bief_allvec(1,seed,  'SEED  ' ,ielmx,1,1,mesh)
      CALL bief_allvec(1,tmelt, 'TMELT ' ,ielmx,1,1,mesh)
      CALL bief_allvec(1,kgm,   'KGM   ' ,ielmx,1,1,mesh)
      CALL bief_allvec(1,epsgm, 'EPSGM ' ,ielmx,1,1,mesh)
      CALL bief_allvec(1,alpgm, 'ALPGM ' ,ielmx,1,1,mesh)
      CALL bief_allvec(1,nutgm, 'NUTGM ' ,ielmx,1,1,mesh)
      IF(thermal_budget) THEN
        CALL allblo(frzl      ,'FRAZIL')
        CALL allblo(nbp       ,'NBPART')
        CALL bief_allvec(1,ntot,  'NTOT  ' ,ielmx,1,1,mesh)
        CALL bief_allvec(1,ctot,  'CTOT  ' ,ielmx,1,1,mesh)
        CALL bief_allvec_in_block(frzl,nc_fra,1,'F     ',
     &                            ielmx,1,1,mesh)
        CALL bief_allvec_in_block(nbp,nc_fra,1,'NBFRZL',
     &                            ielmx,1,1,mesh)
        CALL bief_allvec(1,temp,  'TEMP  ' ,ielmx,1,1,mesh)
        CALL bief_allvec(1,sal ,  'SAL   ' ,ielmx,1,1,mesh)
      ENDIF
!
!     ICE CONCENTRATION AS COMPUTED FROM SURFACE ICE PARTICLES
      CALL bief_allvec(1,anfem , 'COVFC ',ielmx,1,1,mesh)
!
!     ICE COVER DEFINITION - REQUIRED FOR A RESTART
      CALL bief_allvec(1,theta0, 'COVTH0',ielmx,1,1,mesh)
      CALL bief_allvec(1,theta1, 'COVTH1',ielmx,1,1,mesh)
      CALL bief_allvec(1,beta1 , 'COVBT1',ielmx,1,1,mesh)
      CALL bief_allvec(1,vbb   , 'COVVBB',ielmx,1,1,mesh)
      CALL bief_allvec(1,thifem, 'COVTHT',ielmx,1,1,mesh)
      CALL bief_allvec(1,thifems,'COVTHS',ielmx,1,1,mesh)
      CALL bief_allvec(1,thifemf,'COVTHF',ielmx,1,1,mesh)
      CALL bief_allvec(1,hun   , 'COVHUN',ielmx,1,1,mesh)
      CALL bief_allvec(1,icestr, 'ICESTR',ielmx,1,1,mesh)
      CALL bief_allvec(1,vz   ,  'VZ    ',ielmx,1,1,mesh)
      CALL bief_allvec(1,tcr ,   'TCR   ',ielmx,1,1,mesh)
!
!     ICE CHARACTERISATION
      CALL bief_allvec(3,icetype, 'ITYPE ',ielmx,1,1,mesh)
      CALL bief_allvec(3,icetypep,'ITYPEP',ielmx,1,1,mesh)
      CALL bief_allvec(3,iceloc , 'ILOC  ',ielmx,1,1,mesh)
      CALL bief_allvec(3,it1,     'IT1   ',ielmx,1,1,mesh)
      CALL bief_allvec(3,it2,     'IT2   ',ielmx,1,1,mesh)
!
!     CLOGGING SECTION
!
      CALL allblo(msksec,'MSKSEC')
      IF(nseclog.GT.0) THEN
        CALL bief_allvec_in_block(msksec,nseclog,1,'MSKS  ',
     &                            ielm0,1,1,mesh)
      ENDIF
!
!-----------------------------------------------------------------------
!
!     WORKING ARRAYS
!
      ntr = 6
!
!     ALLOCATES NTR WORKING ARRAYS
!     TB WILL CONTAIN ARRAYS T1,T2,...
!
      CALL allblo(tb ,'TB    ')
      CALL bief_allvec_in_block(tb,ntr,1,'TB    ',ielmx,1,2,mesh)
!
!  BM1 AND BM2:
!
      CALL bief_allmat(bm1,'BM1   ',ielmx,ielmx,cfg,'Q','Q',mesh)
      CALL bief_allmat(bm2,'BM2   ',ielmx,ielmx,cfg,'Q','Q',mesh)
      CALL bief_allvec(1,cv1,'CV1   ',ielmx,1,2,mesh)
      CALL bief_allvec(1,cv2,'CV2   ',ielmx,1,2,mesh)
      CALL bief_allvec(1,cv3,'CV3   ',ielmx,1,2,mesh)
      CALL bief_allvec(1,cv4,'CV4   ',ielmx,1,2,mesh)
!
!     ALIAS FOR THE WORKING ARRAYS OF THE BLOCK: TB
!
!     FIRST 2 REQUIRED FOR THE CALL TO WRITE_MESH WITHIN OUTPUT_KHIONE
      t1 =>tb%ADR( 1)%P
      t2 =>tb%ADR( 2)%P
!
!     THESE 4 ARE USED TO COMPUTE VARIOUS ICE COVER ELEVATION
      t3 =>tb%ADR( 3)%P
      t4 =>tb%ADR( 4)%P
      t5 =>tb%ADR( 5)%P
      t6 =>tb%ADR( 6)%P
!
!-----------------------------------------------------------------------
!
!     ALLOCATE THE BLOCK WHICH CONNECTS A VARIABLE NAME TO ITS ARRAY
!     FOR GRAPHICAL OUTPUT
!
      CALL allblo(varsor ,'VARSOR')
!
!     THERMAL BUDGET
!
! 01  SOLAR RADIATION UNDER CLEAR SKY
      CALL addblo(varsor,phcl)
! 02  SOLAR RADIATION UNDER CLOUDY SKY
      CALL addblo(varsor,phri)
! 03  NET SOLAR RADIATION AFTER REFLECTION
      CALL addblo(varsor,phps)
! 04  EFFECTIVE BACK RADIATION
      CALL addblo(varsor,phib)
! 05  EVAPORATION HEAT FLUX
      CALL addblo(varsor,phie)
! 06  CONDUCTIVITY HEAT FLUX
      CALL addblo(varsor,phih)
! 07  PRECIPITATION HEAT FLUX
      CALL addblo(varsor,phip)
!
!     ICE SHEET COVER
!
! 08  PROBABILITY OF FRAZIL DEPOSITION - OPEN WATER
      CALL addblo(varsor,theta0)
! 09  PROBABILITY OF FRAZIL DEPOSITION - ICE COVER
      CALL addblo(varsor,theta1)
! 10  RATE OF REENTRAINMENT OF SURFACE PER UNIT AREA
      CALL addblo(varsor,beta1)
! 11  SETTLING VELOCITY OF FRAZIL ICE IN THE TURBULENT FLOW
      CALL addblo(varsor,vbb)
! 12  ICE CONCENTRATION AS COMPUTED FROM SURFACE ICE PARTICLES
      CALL addblo(varsor,anfem)
! 13  SOLID ICE THICKNESS
      CALL addblo(varsor,thifems)
! 14  FRAZIL ICE THICKNESS
      CALL addblo(varsor,thifemf)
! 15  UNDERCOVER ICE THICKNESS
      CALL addblo(varsor,hun)
! 16  COMPUTED ELEVATIONS WITHIN PRERES_KHIONE (WATER AND ICE COVER)
!     EQUIVALENT SURFACE ELEVATION
      CALL addblo(varsor,t3)
! 17  TOP OF THE ICE COVER
      CALL addblo(varsor,t4)
! 18  BOTTOM OF THE ICE COVER (ALSO THE FREE SURFACE))
      CALL addblo(varsor,t5)
! 19  TOTAL ICE THICKNESS
      CALL addblo(varsor,thifem)
! 20  ICE CHARACTERISATION
      CALL addblo(varsor,icetype)
! 21  NUMBER OF PARTICLES
      CALL addblo(varsor,ntot)
! 22  FRAZIL TOTAL CONCENTRATION
      CALL addblo(varsor,ctot)
!
      ilast = 22
      IF(ilast.NE.varsor%N) THEN
        WRITE(lu,*) 'MESSAGE TO DEVELOPPERS:'
        WRITE(lu,*) 'CHANGE ILAST INTO ',varsor%N
        WRITE(lu,*) 'IN POINT_KHIONE'
        CALL plante(1)
        stop
      ENDIF
!
!     TELEMAC-2D TRACER VALUES
!
      IF(thermal_budget) THEN
        DO i=1,nc_fra
          CALL addblo(varsor,frzl%ADR(i)%P)
        ENDDO
        DO i=1,nc_fra
          CALL addblo(varsor,nbp%ADR(i)%P)
        ENDDO
        CALL addblo(varsor,temp)
        CALL addblo(varsor,sal)
      ENDIF
!
!-----------------------------------------------------------------------
!
!     DIFFERENTIATED VARIABLES
!
      IF( nadvar.GT.0 ) THEN
        j = varsor%N + 1
        CALL allblo(advar ,'ADVAR ')
        CALL bief_allvec_in_block(advar,nadvar,1,'AD    ',ielmx,
     &                            1,2,mesh)
        DO i = 1,nadvar
          CALL ad_get_khione(i,advar%ADR(i)%P)
!
          IF( j.GT.maxvar ) THEN
            IF(lng.EQ.1) THEN
              WRITE(lu,*) 'POINT : TROP DE DERIVEES A IMPRIMER'
            ENDIF
            IF(lng.EQ.2) THEN
              WRITE(lu,*) 'POINT : TOO MANY DERIVATIVES TO PRINT OUT'
            ENDIF
            CALL plante(1)
            stop
          ENDIF
!
          IF( sorleo(j).OR.sorimp(j) ) THEN
            CALL addblo(varsor,advar%ADR(i)%P)
            j = j + 1
          ENDIF
!
        ENDDO
      ENDIF
!
!***********************************************************************
!
!-----------------------------------------------------------------------
!
      RETURN
      END