Back to home page

MITgcm
 
 

    

File indexing completed on 2021-05-08 05:11:31 UTC

view on githubraw file Latest commit 9c41af81 on 2021-05-07 16:55:09 UTC
8ac664a04c Step*0001 #include "GCHEM_OPTIONS.h"
d8cece0eeb Jean*0002 #ifdef ALLOW_SEAICE
                0003 # include "SEAICE_OPTIONS.h"
                0004 #endif /* ALLOW_SEAICE */
                0005 #ifdef ALLOW_THSICE
                0006 # include "THSICE_OPTIONS.h"
                0007 #endif /* ALLOW_THSICE */
9c41af81f6 Timo*0008 #ifdef ALLOW_AUTODIFF
                0009 # include "AUTODIFF_OPTIONS.h"
                0010 #endif
8ac664a04c Step*0011 
d8cece0eeb Jean*0012 CBOP
                0013 C     !ROUTINE: CFC12_FORCING
                0014 C     !INTERFACE:
8ac664a04c Step*0015       SUBROUTINE CFC_FIELDS_LOAD (
d8cece0eeb Jean*0016      I           myTime, myIter, myThid )
8ac664a04c Step*0017 
d8cece0eeb Jean*0018 C     !DESCRIPTION:
03c07845ac Jean*0019 C     *==========================================================*
                0020 C     | SUBROUTINE CFC_FIELDS_LOAD
                0021 C     *==========================================================*
                0022 
d8cece0eeb Jean*0023 C     !USES:
8ac664a04c Step*0024       IMPLICIT NONE
                0025 
                0026 C     == GLobal variables ==
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030 #include "GRID.h"
                0031 #include "CFC.h"
c7d9898dee Mart*0032 #ifdef ALLOW_EXF
                0033 # include "EXF_FIELDS.h"
85f77391e5 Jean*0034 #endif
c7d9898dee Mart*0035 #ifdef ALLOW_SEAICE
a34cef4f76 Jean*0036 # include "SEAICE_SIZE.h"
c7d9898dee Mart*0037 # include "SEAICE.h"
85f77391e5 Jean*0038 #endif
d8cece0eeb Jean*0039 #ifdef ALLOW_THSICE
                0040 # include "THSICE_VARS.h"
                0041 #endif /* ALLOW_THSICE */
8ac664a04c Step*0042 
d8cece0eeb Jean*0043 C     !INPUT/OUTPUT PARAMETERS:
                0044 C     myTime     :: current time in simulation
                0045 C     myIter     :: current iteration number
                0046 C     myThid     :: my Thread Id number
8ac664a04c Step*0047       _RL myTime
d8cece0eeb Jean*0048       INTEGER myIter
8ac664a04c Step*0049       INTEGER myThid
                0050 
d8cece0eeb Jean*0051 C     !LOCAL VARIABLES:
03c07845ac Jean*0052       INTEGER intimeP, intime0, intime1
                0053        INTEGER bi, bj, i, j
                0054       _RL aWght, bWght
561daed999 Jean*0055       _RL locWind(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
d8cece0eeb Jean*0056 CEOP
03c07845ac Jean*0057 
9a5cf9751b Jean*0058       IF ( CFC_forcingCycle .GT. 0. _d 0 ) THEN
8ac664a04c Step*0059 
                0060 C First call requires that we initialize everything to zero for safety
                0061 cQQQ need to check timing
e8625f0081 Step*0062        IF ( myIter .EQ. nIter0 ) THEN
03c07845ac Jean*0063          DO bj = myByLo(myThid), myByHi(myThid)
                0064           DO bi = myBxLo(myThid), myBxHi(myThid)
                0065             CFC_ldRec(bi,bj) = 0
                0066           ENDDO
                0067          ENDDO
98879b20bc Mart*0068          CALL LEF_ZERO( wind0,myThid )
                0069          CALL LEF_ZERO( wind1,myThid )
8ac664a04c Step*0070          CALL LEF_ZERO( atmosp0,myThid )
                0071          CALL LEF_ZERO( atmosp1,myThid )
                0072          CALL LEF_ZERO( ice0,myThid )
                0073          CALL LEF_ZERO( ice1,myThid )
                0074        ENDIF
                0075 
03c07845ac Jean*0076 C--   Now calculate whether it is time to update the forcing arrays
                0077        CALL GET_PERIODIC_INTERVAL(
                0078      O                   intimeP, intime0, intime1, bWght, aWght,
                0079      I                   CFC_forcingCycle, CFC_forcingPeriod,
9c41af81f6 Timo*0080      I                   deltaTClock, myTime, myThid )
8ac664a04c Step*0081 
03c07845ac Jean*0082        bi = myBxLo(myThid)
                0083        bj = myByLo(myThid)
                0084 #ifdef ALLOW_DEBUG
7250857647 Jean*0085        IF ( debugLevel.GE.debLevB ) THEN
3247fa4f0b Jean*0086         _BEGIN_MASTER(myThid)
03c07845ac Jean*0087         WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
                0088      &   ' CFC_FIELDS_LOAD,', myIter,
                0089      &   ' : iP,iLd,i0,i1=', intimeP,CFC_ldRec(bi,bj), intime0,intime1,
                0090      &   ' ; Wght=', bWght, aWght
                0091         _END_MASTER(myThid)
                0092        ENDIF
                0093 #endif /* ALLOW_DEBUG */
                0094 
                0095 #ifdef ALLOW_AUTODIFF_TAMC
                0096 C-    assuming that we call S/R CFC_FIELDS_LOAD at each time-step and
                0097 C     with increasing time, this will catch when we need to load new records;
                0098 C     But with Adjoint run, this is not always the case => might end-up using
                0099 C     the wrong time-records
                0100        IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
                0101 #else /* ALLOW_AUTODIFF_TAMC */
                0102 C-    Make no assumption on sequence of calls to CFC_FIELDS_LOAD ;
                0103 C     This is the correct formulation (works in Adjoint run).
                0104 C     Unfortunatly, might produce many recomputations <== not used until it is fixed
                0105        IF ( intime1.NE.CFC_ldRec(bi,bj) ) THEN
                0106 #endif /* ALLOW_AUTODIFF_TAMC */
                0107 
                0108 C--   If the above condition is met then we need to read in
                0109 C     data for the period ahead and the period behind myTime.
7250857647 Jean*0110         IF ( debugLevel.GE.debLevZero ) THEN
                0111          _BEGIN_MASTER(myThid)
                0112          WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
                0113      &    ' CFC_FIELDS_LOAD, it=', myIter,
                0114      &    ' : Reading new data, i0,i1=', intime0, intime1,
03c07845ac Jean*0115      &    ' (prev=', intimeP, CFC_ldRec(bi,bj), ' )'
7250857647 Jean*0116          _END_MASTER(myThid)
                0117         ENDIF
03c07845ac Jean*0118 
                0119         _BARRIER
8ac664a04c Step*0120 
03c07845ac Jean*0121         IF ( CFC_windFile .NE. ' '  .AND. .NOT.useEXF ) THEN
9a5cf9751b Jean*0122          CALL READ_REC_XY_RS( CFC_windFile,wind0,intime0,
8ac664a04c Step*0123      &        myIter,myThid )
9a5cf9751b Jean*0124          CALL READ_REC_XY_RS( CFC_windFile,wind1,intime1,
8ac664a04c Step*0125      &        myIter,myThid )
03c07845ac Jean*0126         ENDIF
                0127         IF ( CFC_atmospFile .NE. ' '  ) THEN
9a5cf9751b Jean*0128          CALL READ_REC_XY_RS( CFC_atmospFile,atmosp0,intime0,
8ac664a04c Step*0129      &        myIter,myThid )
9a5cf9751b Jean*0130          CALL READ_REC_XY_RS( CFC_atmospFile,atmosp1,intime1,
8ac664a04c Step*0131      &        myIter,myThid )
03c07845ac Jean*0132         ENDIF
d8cece0eeb Jean*0133         IF ( CFC_iceFile .NE. ' ' .AND.
                0134      &       .NOT.useSEAICE .AND. .NOT.useThSIce ) THEN
9a5cf9751b Jean*0135          CALL READ_REC_XY_RS( CFC_iceFile,ice0,intime0,
8ac664a04c Step*0136      &       myIter,myThid )
9a5cf9751b Jean*0137          CALL READ_REC_XY_RS( CFC_iceFile,ice1,intime1,
8ac664a04c Step*0138      &       myIter,myThid )
03c07845ac Jean*0139         ENDIF
                0140 
d8cece0eeb Jean*0141         IF ( .NOT.useEXF ) THEN
03c07845ac Jean*0142          _EXCH_XY_RS(wind0, myThid )
                0143          _EXCH_XY_RS(wind1, myThid )
                0144         ENDIF
                0145          _EXCH_XY_RS(atmosp0, myThid )
                0146          _EXCH_XY_RS(atmosp1, myThid )
d8cece0eeb Jean*0147         IF ( .NOT.useSEAICE .AND. .NOT.useThSIce ) THEN
03c07845ac Jean*0148          _EXCH_XY_RS(ice0, myThid )
                0149          _EXCH_XY_RS(ice1, myThid )
                0150         ENDIF
                0151 
                0152 C-    save newly loaded time-record
                0153         DO bj = myByLo(myThid), myByHi(myThid)
                0154          DO bi = myBxLo(myThid), myBxHi(myThid)
                0155            CFC_ldRec(bi,bj) = intime1
                0156          ENDDO
                0157         ENDDO
8ac664a04c Step*0158 
03c07845ac Jean*0159 C--   end if-block for loading new time-records
8ac664a04c Step*0160        ENDIF
                0161 
561daed999 Jean*0162 C endif for periodicForcing
                0163       ENDIF
                0164 
                0165       DO bj = myByLo(myThid), myByHi(myThid)
                0166        DO bi = myBxLo(myThid), myBxHi(myThid)
                0167 
98879b20bc Mart*0168 #ifdef ALLOW_EXF
561daed999 Jean*0169         IF ( useEXF ) THEN
                0170           DO j=1-OLy,sNy+OLy
                0171            DO i=1-OLx,sNx+OLx
c7d9898dee Mart*0172 C     sh = max(wspeed,umin), with default umin=0.5m/s
561daed999 Jean*0173 c            locWind(i,j) = wspeed(i,j,bi,bj)
                0174              locWind(i,j) = sh(i,j,bi,bj)
                0175            ENDDO
98879b20bc Mart*0176           ENDDO
561daed999 Jean*0177         ELSEIF ( CFC_forcingCycle.GT.zeroRL
                0178      &           .AND. CFC_windFile.NE.' ' ) THEN
c7d9898dee Mart*0179 #else
561daed999 Jean*0180         IF     ( CFC_forcingCycle.GT.zeroRL
                0181      &           .AND. CFC_windFile.NE.' ' ) THEN
98879b20bc Mart*0182 #endif /* ALLOW_EXF */
561daed999 Jean*0183           DO j=1-OLy,sNy+OLy
                0184            DO i=1-OLx,sNx+OLx
                0185              locWind(i,j) = bWght*wind0(i,j,bi,bj)
                0186      &                    + aWght*wind1(i,j,bi,bj)
                0187            ENDDO
                0188           ENDDO
                0189         ELSE
                0190           DO j=1-OLy,sNy+OLy
                0191            DO i=1-OLx,sNx+OLx
                0192              locWind(i,j) = 5. _d 0*maskC(i,j,1,bi,bj)
                0193            ENDDO
                0194           ENDDO
                0195         ENDIF
8ac664a04c Step*0196 c calculate piston velocity
                0197 c QQ: note - we should have wind speed variance in here
65cad54250 Step*0198 c following Wannikof (1992)
561daed999 Jean*0199         DO j=1-OLy,sNy+OLy
                0200           DO i=1-OLx,sNx+OLx
d8cece0eeb Jean*0201             pisVel(i,j,bi,bj)=(0.31 _d 0*locWind(i,j)**2)/3.6 _d 5
98879b20bc Mart*0202           ENDDO
                0203         ENDDO
561daed999 Jean*0204 
                0205         IF ( CFC_forcingCycle.GT.zeroRL
                0206      &       .AND. CFC_atmospFile.NE.' ' ) THEN
                0207           DO j=1-OLy,sNy+OLy
                0208            DO i=1-OLx,sNx+OLx
98879b20bc Mart*0209              ATMOSP(i,j,bi,bj) = bWght*atmosp0(i,j,bi,bj)
561daed999 Jean*0210      &                         + aWght*atmosp1(i,j,bi,bj)
                0211            ENDDO
                0212           ENDDO
                0213         ELSE
                0214           DO j=1-OLy,sNy+OLy
                0215            DO i=1-OLx,sNx+OLx
3247fa4f0b Jean*0216              ATMOSP(i,j,bi,bj) = maskC(i,j,1,bi,bj)
561daed999 Jean*0217            ENDDO
98879b20bc Mart*0218           ENDDO
561daed999 Jean*0219         ENDIF
                0220 
d8cece0eeb Jean*0221         IF ( useThSIce ) THEN
                0222 #ifdef ALLOW_THSICE
                0223           DO j=1-OLy,sNy+OLy
                0224            DO i=1-OLx,sNx+OLx
9c41af81f6 Timo*0225              FIce(i,j,bi,bj) = iceMask(i,j,bi,bj)
d8cece0eeb Jean*0226            ENDDO
                0227           ENDDO
                0228 #endif /* ALLOW_THSICE */
                0229         ELSEIF ( useSEAICE ) THEN
c7d9898dee Mart*0230 #ifdef ALLOW_SEAICE
561daed999 Jean*0231           DO j=1-OLy,sNy+OLy
                0232            DO i=1-OLx,sNx+OLx
9c41af81f6 Timo*0233              FIce(i,j,bi,bj) = AREA(i,j,bi,bj)
561daed999 Jean*0234            ENDDO
                0235           ENDDO
d8cece0eeb Jean*0236 #endif /* ALLOW_SEAICE */
561daed999 Jean*0237         ELSEIF ( CFC_forcingCycle.GT.zeroRL
                0238      &           .AND. CFC_iceFile.NE.' ' ) THEN
a34cef4f76 Jean*0239          DO j=1-OLy,sNy+OLy
                0240           DO i=1-OLx,sNx+OLx
561daed999 Jean*0241              FIce(i,j,bi,bj) = bWght*ice0(i,j,bi,bj)
                0242      &                       + aWght*ice1(i,j,bi,bj)
98879b20bc Mart*0243           ENDDO
                0244          ENDDO
561daed999 Jean*0245         ELSE
a34cef4f76 Jean*0246          DO j=1-OLy,sNy+OLy
                0247           DO i=1-OLx,sNx+OLx
561daed999 Jean*0248              FIce(i,j,bi,bj) = 0. _d 0
8ac664a04c Step*0249           ENDDO
                0250          ENDDO
561daed999 Jean*0251         ENDIF
8ac664a04c Step*0252 
561daed999 Jean*0253 C--   end bi.bj loops
                0254        ENDDO
                0255       ENDDO
8ac664a04c Step*0256 
                0257       RETURN
                0258       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!