Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:38:24 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
ced0783fba Jean*0001 #include "CHEAPAML_OPTIONS.h"
cf5b5345a0 Jean*0002 
be1d1f7787 Jean*0003 CBOP
                0004 C     !ROUTINE: CHEAPAML_INIT_VARIA
                0005 C     !INTERFACE:
cf5b5345a0 Jean*0006       SUBROUTINE CHEAPAML_INIT_VARIA( myThid )
be1d1f7787 Jean*0007 
                0008 C     !DESCRIPTION:
a910385b8c Jean*0009 C     *==========================================================*
                0010 C     | SUBROUTINE CHEAPAML_INIT_VARIA
                0011 C     | o Set cheapaml initial temp field
                0012 C     *==========================================================*
cf5b5345a0 Jean*0013 
be1d1f7787 Jean*0014 C     !USES:
                0015       IMPLICIT NONE
cf5b5345a0 Jean*0016 C     === Global variables ===
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
2616d73cb2 Nico*0020 #include "GRID.h"
4fa4901be6 Nico*0021 #include "FFIELDS.h"
cf5b5345a0 Jean*0022 #include "CHEAPAML.h"
                0023 
be1d1f7787 Jean*0024 C     !INPUT PARAMETERS:
a910385b8c Jean*0025 C     myThid :: my Thread Id number
cf5b5345a0 Jean*0026       INTEGER myThid
be1d1f7787 Jean*0027 CEOP
cf5b5345a0 Jean*0028 
a7ebcd221c Jean*0029 C     !FUNCTIONS
                0030       INTEGER  ILNBLNK
                0031       EXTERNAL ILNBLNK
                0032 
be1d1f7787 Jean*0033 C     !LOCAL VARIABLES:
                0034 C     bi,bj  :: tile indices
                0035 C     i,j    :: grid-point indices
a7ebcd221c Jean*0036 C     msgBuf :: Informational/error message buffer
cf5b5345a0 Jean*0037       INTEGER bi, bj
a910385b8c Jean*0038       INTEGER i, j
                0039       INTEGER iG,jG
7e0a43f4a2 Jean*0040       _RL local, localt
be1d1f7787 Jean*0041       _RL ssqa
7e0a43f4a2 Jean*0042       _RL recipNym1
a7ebcd221c Jean*0043       INTEGER iL, ioUnit
                0044       CHARACTER*(MAX_LEN_MBUF) msgBuf
a910385b8c Jean*0045 C     INTEGER prec
                0046 C     CHARACTER*(MAX_LEN_FNAM) fn
cf5b5345a0 Jean*0047 
a7ebcd221c Jean*0048       ioUnit = standardMessageUnit
be1d1f7787 Jean*0049       recipNym1 = Ny - 1
                0050       IF ( Ny.GT.1 ) recipNym1 = 1. _d 0 / recipNym1
4fa4901be6 Nico*0051 
a910385b8c Jean*0052 C--   Initialise CheapAML variables in common block:
                0053       DO bj = myByLo(myThid), myByHi(myThid)
                0054        DO bi = myBxLo(myThid), myBxHi(myThid)
                0055         DO j=1-OLy,sNy+OLy
                0056          DO i=1-OLx,sNx+OLx
                0057           Tr            (i,j,bi,bj) = 0. _d 0
                0058           qr            (i,j,bi,bj) = 0. _d 0
                0059           Tair          (i,j,bi,bj) = 0. _d 0
                0060           gTairm        (i,j,bi,bj) = 0. _d 0
                0061           qair          (i,j,bi,bj) = 0. _d 0
                0062           gqairm        (i,j,bi,bj) = 0. _d 0
cc99c9c4f4 Jean*0063           uWind         (i,j,bi,bj) = 0. _d 0
                0064           vWind         (i,j,bi,bj) = 0. _d 0
                0065           wWind         (i,j,bi,bj) = 0. _d 0
a910385b8c Jean*0066           solar         (i,j,bi,bj) = 0. _d 0
                0067           ustress       (i,j,bi,bj) = 0. _d 0
                0068           vstress       (i,j,bi,bj) = 0. _d 0
                0069           wavesh        (i,j,bi,bj) = 0. _d 0
                0070           wavesp        (i,j,bi,bj) = 0. _d 0
cc99c9c4f4 Jean*0071           cheapPrecip   (i,j,bi,bj) = 0. _d 0
a910385b8c Jean*0072           CheapHgrid    (i,j,bi,bj) = 0. _d 0
7e0a43f4a2 Jean*0073 c         cheapPrGrid   (i,j,bi,bj) = 0. _d 0
a910385b8c Jean*0074           Cheapclouds   (i,j,bi,bj) = 0. _d 0
                0075           Cheapdlongwave(i,j,bi,bj) = 0. _d 0
                0076           Cheaptracer   (i,j,bi,bj) = 0. _d 0
                0077           CheaptracerR  (i,j,bi,bj) = 0. _d 0
                0078           gCheaptracerm (i,j,bi,bj) = 0. _d 0
                0079          ENDDO
                0080         ENDDO
                0081        ENDDO
                0082       ENDDO
cf5b5345a0 Jean*0083 
c4299e608a Nico*0084       IF ( startTime.EQ.baseTime .AND. nIter0.EQ.0
a910385b8c Jean*0085      &                           .AND. pickupSuff.EQ.' ' ) THEN
c4299e608a Nico*0086 
a910385b8c Jean*0087        IF ( AirTempFile .NE. ' ' ) THEN
a7ebcd221c Jean*0088          iL = ILNBLNK(AirTempFile)
                0089          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0090      &      'Tair initialized from ->', AirTempFile(1:iL), '<-'
                0091          CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ced0783fba Jean*0092          CALL READ_FLD_XY_RL( AirTempFile,' ',Tair,0,myThid )
a910385b8c Jean*0093        ELSE
a7ebcd221c Jean*0094          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0095      &      'Tair initialized using standard profile'
                0096          CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ced0783fba Jean*0097          DO bj = myByLo(myThid), myByHi(myThid)
                0098           DO bi = myBxLo(myThid), myBxHi(myThid)
a910385b8c Jean*0099            DO j=1,sNy
                0100             DO i=1,sNx
                0101              jG = myYGlobalLo-1+(bj-1)*sNy+j
be1d1f7787 Jean*0102              iG = myXGlobalLo-1+(bi-1)*sNx+i
                0103              localt = 25. _d 0 - (jG-1)*recipNym1*10. _d 0
                0104              localt = 20. _d 0
                0105      &         + 10. _d 0*EXP( -( (jG-30)**2+(iG-30)**2 )/100. _d 0 )
a910385b8c Jean*0106              Tair(i,j,bi,bj) = localt
cf5b5345a0 Jean*0107             ENDDO
ced0783fba Jean*0108            ENDDO
a910385b8c Jean*0109           ENDDO
cf5b5345a0 Jean*0110          ENDDO
a910385b8c Jean*0111        ENDIF
7e0a43f4a2 Jean*0112        _EXCH_XY_RL( Tair, myThid )
a910385b8c Jean*0113 
                0114 C do specific humidity
4fa4901be6 Nico*0115        IF ( AirQFile .NE. ' ') THEN
a7ebcd221c Jean*0116          iL = ILNBLNK(AirQFile)
                0117          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0118      &      'Qair initialized from ->', AirQFile(1:iL), '<-'
                0119          CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
a910385b8c Jean*0120          CALL READ_FLD_XY_RL( AirQFile,' ',qair,0,myThid )
4fa4901be6 Nico*0121        ELSE
a910385b8c Jean*0122 C     default to 80% relative humidity
a7ebcd221c Jean*0123          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0124      &      'Qair initialized using standard profile'
                0125          CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
ced0783fba Jean*0126          DO bj = myByLo(myThid), myByHi(myThid)
a910385b8c Jean*0127           DO bi = myBxLo(myThid), myBxHi(myThid)
                0128            DO j=1,sNy
                0129             DO i=1,sNx
be1d1f7787 Jean*0130              local= Tair(i,j,bi,bj)+celsius2K
                0131              ssqa = ssq0*EXP( lath*(ssq1-ssq2/local) ) / p0
a910385b8c Jean*0132              qair(i,j,bi,bj)=0.8 _d 0*ssqa
                0133             ENDDO
ced0783fba Jean*0134            ENDDO
a910385b8c Jean*0135           ENDDO
ced0783fba Jean*0136          ENDDO
4fa4901be6 Nico*0137        ENDIF
7e0a43f4a2 Jean*0138        _EXCH_XY_RL( qair, myThid )
51132e5783 Nico*0139 
                0140 C do passive tracer
                0141        IF ( TracerFile .NE. ' ') THEN
a7ebcd221c Jean*0142          iL = ILNBLNK(TracerFile)
                0143          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0144      &      'Tracer initialized from ->', TracerFile(1:iL), '<-'
                0145          CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0146          CALL READ_FLD_XY_RL( TracerFile,' ',Cheaptracer,0,myThid )
a910385b8c Jean*0147        ELSE
51132e5783 Nico*0148 C default value at 290 (!)
a7ebcd221c Jean*0149          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0150      &      'Tracer initialized using standard profile'
                0151          CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0152          DO bj = myByLo(myThid), myByHi(myThid)
                0153           DO bi = myBxLo(myThid), myBxHi(myThid)
                0154            DO j=1,sNy
                0155             DO i=1,sNx
51132e5783 Nico*0156              Cheaptracer(i,j,bi,bj)=290.0 _d 0
a7ebcd221c Jean*0157             ENDDO
51132e5783 Nico*0158            ENDDO
a910385b8c Jean*0159           ENDDO
                0160          ENDDO
                0161        ENDIF
7e0a43f4a2 Jean*0162        _EXCH_XY_RL( Cheaptracer, myThid )
51132e5783 Nico*0163 
a910385b8c Jean*0164       ELSE
c4299e608a Nico*0165 C Restart from cheapaml_pickups
a910385b8c Jean*0166        CALL CHEAPAML_READ_PICKUP( nIter0, myThid )
                0167 C End start-from-iter-zero if/else block
                0168       ENDIF
c4299e608a Nico*0169 
2616d73cb2 Nico*0170 C     construct cheaplayer thickness
                0171        IF ( cheap_hFile .NE. ' ') THEN
a7ebcd221c Jean*0172          iL = ILNBLNK(cheap_hFile)
                0173          WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
                0174      &      'BL thickness taken from ->', cheap_hFile(1:iL), '<-'
                0175          CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
cc99c9c4f4 Jean*0176          CALL READ_FLD_XY_RL( cheap_hFile,' ',cheapHgrid,0,myThid )
2616d73cb2 Nico*0177        ELSE
                0178          DO bj = myByLo(myThid), myByHi(myThid)
be1d1f7787 Jean*0179           DO bi = myBxLo(myThid), myBxHi(myThid)
                0180             DO j=1-OLy,sNy+OLy
                0181              DO i=1-OLx,sNx+OLx
cc99c9c4f4 Jean*0182                cheapHgrid(i,j,bi,bj) = cheapaml_h
2616d73cb2 Nico*0183              ENDDO
be1d1f7787 Jean*0184             ENDDO
                0185           ENDDO
2616d73cb2 Nico*0186          ENDDO
                0187        ENDIF
7e0a43f4a2 Jean*0188        _EXCH_XY_RL( CheapHgrid, myThid )
2616d73cb2 Nico*0189 
be1d1f7787 Jean*0190 c!BD       IF ( cheap_prFile .NE. ' ') THEN
a910385b8c Jean*0191 c!BD        write(*,*)'Conv precip taken from  ->',cheap_prFile
7e0a43f4a2 Jean*0192 c!BD        CALL READ_FLD_XY_RL( cheap_prFile,' ',cheapPrGrid,0,myThid )
a910385b8c Jean*0193 c!BD       ELSE
                0194 c!BD         DO bj = myByLo(myThid), myByHi(myThid)
                0195 c!BD           DO bi = myBxLo(myThid), myBxHi(myThid)
                0196 c!BD             DO j=1-OLy,sNy+OLy
                0197 c!BD               DO i=1-OLx,sNx+OLx
7e0a43f4a2 Jean*0198 c!BD               cheapPrGrid(i,j,bi,bj) = 0.0 _d 0
a910385b8c Jean*0199 c!BD               ENDDO
                0200 c!BD             ENDDO
                0201 c!BD           ENDDO
                0202 c!BD         ENDDO
                0203 c!BD       ENDIF
7e0a43f4a2 Jean*0204 c!BD        _EXCH_XY_RL( cheapPrGrid, myThid )
ced0783fba Jean*0205 
a910385b8c Jean*0206 C fill in outer edges
                0207        DO bj = myByLo(myThid), myByHi(myThid)
                0208         DO bi = myBxLo(myThid), myBxHi(myThid)
                0209           DO j=1-OLy,sNy+OLy
                0210            jG = myYGlobalLo-1+(bj-1)*sNy+j
                0211            DO i=1-OLx,sNx+OLx
                0212              iG=myXGlobalLo-1+(bi-1)*sNx+i
082180ce2a Jean*0213              IF ( .NOT.cheapamlXperiodic .AND. iG.LT.1 ) THEN
4fa4901be6 Nico*0214                  Tair(i,j,bi,bj)=Tair(1,j,bi,bj)
                0215                  qair(i,j,bi,bj)=qair(1,j,bi,bj)
51132e5783 Nico*0216                  Cheaptracer(i,j,bi,bj)=Cheaptracer(1,j,bi,bj)
cc99c9c4f4 Jean*0217                  CheapHgrid(i,j,bi,bj)=CheapHgrid(1,j,bi,bj)
082180ce2a Jean*0218              ELSEIF ( .NOT.cheapamlXperiodic .AND. iG.GT.Nx ) THEN
4fa4901be6 Nico*0219                  Tair(i,j,bi,bj)=Tair(sNx,j,bi,bj)
                0220                  qair(i,j,bi,bj)=qair(sNx,j,bi,bj)
51132e5783 Nico*0221                  Cheaptracer(i,j,bi,bj)=Cheaptracer(sNx,j,bi,bj)
cc99c9c4f4 Jean*0222                  CheapHgrid(i,j,bi,bj)=CheapHgrid(sNx,j,bi,bj)
082180ce2a Jean*0223              ELSEIF ( .NOT.cheapamlYperiodic .AND.  jG.LT.1 ) THEN
4fa4901be6 Nico*0224                  Tair(i,j,bi,bj)=Tair(i,1,bi,bj)
                0225                  qair(i,j,bi,bj)=qair(i,1,bi,bj)
51132e5783 Nico*0226                  Cheaptracer(i,j,bi,bj)=Cheaptracer(i,1,bi,bj)
cc99c9c4f4 Jean*0227                  CheapHgrid(i,j,bi,bj)=CheapHgrid(i,1,bi,bj)
082180ce2a Jean*0228              ELSEIF ( .NOT.cheapamlYperiodic .AND.  jG.GT.Ny ) THEN
4fa4901be6 Nico*0229                  Tair(i,j,bi,bj)=Tair(i,sNy,bi,bj)
                0230                  qair(i,j,bi,bj)=qair(i,sNy,bi,bj)
51132e5783 Nico*0231                  Cheaptracer(i,j,bi,bj)=Cheaptracer(i,sNy,bi,bj)
cc99c9c4f4 Jean*0232                  CheapHgrid(i,j,bi,bj)=CheapHgrid(i,sNy,bi,bj)
a910385b8c Jean*0233              ENDIF
4fa4901be6 Nico*0234            ENDDO
ced0783fba Jean*0235           ENDDO
a910385b8c Jean*0236         ENDDO
                0237        ENDDO
cf5b5345a0 Jean*0238 
082180ce2a Jean*0239       IF ( debugLevel.GE.debLevB .AND. nIter0.EQ.0 ) THEN
                0240         CALL WRITE_FLD_XY_RL('CheapHgrid', ' ', CheapHgrid, 0, myThid )
                0241       ENDIF
                0242 
cf5b5345a0 Jean*0243       RETURN
                0244       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!