Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:45:19 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
1b23894ba3 Jean*0001 #include "AIM_OPTIONS.h"
                0002 
486e38797b Jean*0003 CBOP
                0004 C     !ROUTINE: AIM_SURF_BC
                0005 C     !INTERFACE:
717a660aff Jean*0006       SUBROUTINE AIM_SURF_BC(
                0007      U                        tYear,
                0008      O                        aim_sWght0, aim_sWght1,
                0009      I                        bi, bj, myTime, myIter, myThid )
486e38797b Jean*0010 
                0011 C     !DESCRIPTION: \bv
1b23894ba3 Jean*0012 C     *================================================================*
                0013 C     | S/R AIM_SURF_BC
717a660aff Jean*0014 C     | Set surface Boundary Conditions
1b23894ba3 Jean*0015 C     |  for the atmospheric physics package
                0016 C     *================================================================*
                0017 c     | was part of S/R FORDATE in Franco Molteni SPEEDY code (ver23).
                0018 C     | For now, surface BC are loaded from files (S/R AIM_FIELDS_LOAD)
                0019 C     |  and imposed (= surf. forcing).
717a660aff Jean*0020 C     | In the future, will add
1b23894ba3 Jean*0021 C     |  a land model and a coupling interface with an ocean GCM
                0022 C     *================================================================*
486e38797b Jean*0023 C     \ev
                0024 
                0025 C     !USES:
1b23894ba3 Jean*0026       IMPLICIT NONE
                0027 
                0028 C     -------------- Global variables --------------
                0029 C-- size for MITgcm & Physics package :
                0030 #include "AIM_SIZE.h"
                0031 
                0032 C-- MITgcm
                0033 #include "EEPARAMS.h"
                0034 #include "PARAMS.h"
f23a68699b Jean*0035 C_EqCh: start
                0036 #ifdef ALLOW_EXCH2
                0037 # include "W2_EXCH2_SIZE.h"
                0038 #endif /* ALLOW_EXCH2 */
                0039 #include "SET_GRID.h"
                0040 C_EqCh: end
1b23894ba3 Jean*0041 #include "GRID.h"
f23a68699b Jean*0042 c #include "DYNVARS.h"
1b23894ba3 Jean*0043 c #include "SURFACE.h"
                0044 
                0045 C-- Physics package
                0046 #include "AIM_PARAMS.h"
                0047 #include "AIM_FFIELDS.h"
                0048 c #include "AIM_GRID.h"
                0049 #include "com_forcon.h"
                0050 #include "com_forcing.h"
                0051 c #include "com_physvar.h"
486e38797b Jean*0052 #include "AIM_CO2.h"
1b23894ba3 Jean*0053 
                0054 C-- Coupled to the Ocean :
                0055 #ifdef COMPONENT_MODULE
                0056 #include "CPL_PARAMS.h"
                0057 #include "ATMCPL.h"
                0058 #endif
                0059 
486e38797b Jean*0060 C     !INPUT/OUTPUT PARAMETERS:
1b23894ba3 Jean*0061 C     == Routine arguments ==
717a660aff Jean*0062 C     tYear      :: Fraction into year
                0063 C     aim_sWght0 :: weight for time interpolation of surface BC
                0064 C     aim_sWght1 :: 0/1 = time period before/after the current time
                0065 C     bi,bj      :: Tile indices
                0066 C     myTime     :: Current time of simulation ( s )
                0067 C     myIter     :: Current iteration number in simulation
                0068 C     myThid     :: my Thread number Id.
                0069       _RL     tYear
                0070       _RL     aim_sWght0, aim_sWght1
                0071       INTEGER bi, bj
                0072       _RL     myTime
                0073       INTEGER myIter, myThid
486e38797b Jean*0074 CEOP
1b23894ba3 Jean*0075 
                0076 #ifdef ALLOW_AIM
486e38797b Jean*0077 C     !FUNCTIONS:
                0078 C     !LOCAL VARIABLES:
                0079 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0080 C--   Local Variables originally (Speedy) in common bloc (com_forcing.h):
                0081 C--   COMMON /FORDAY/ Daily forcing fields (updated in FORDATE)
                0082 C     oice1      :: sea ice fraction
                0083 C     snow1      :: snow depth (mm water)
                0084       _RL     oice1(NGP)
                0085       _RL     snow1(NGP)
                0086 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1b23894ba3 Jean*0087 C     == Local variables ==
717a660aff Jean*0088 C     i,j,k,I2,k   :: Loop counters
                0089       INTEGER i,j,I2,k, nm0
                0090       _RL t0prd, tNcyc, tmprd, dTprd
1b23894ba3 Jean*0091       _RL SDEP1, IDEP2, SDEP2, SWWIL2, RSW, soilw_0, soilw_1
486e38797b Jean*0092       _RL RSD, alb_land, oceTfreez, ALBSEA1, ALPHA, CZEN, CZEN2
                0093       _RL RZEN, ZS, ZC, SJ, CJ, TMPA, TMPB, TMPL, hlim
f36c04300b Jean*0094 c     _RL DALB, alb_sea
486e38797b Jean*0095 #ifdef ALLOW_AIM_CO2
                0096 #ifdef ALLOW_DIAGNOSTICS
                0097       _RL pCO2scl
                0098 #endif
                0099 #endif /* ALLOW_AIM_CO2 */
1b23894ba3 Jean*0100 
                0101 C_EqCh: start
                0102       CHARACTER*(MAX_LEN_MBUF) suff
                0103       _RL xBump, yBump, dxBump, dyBump
fdb16198f0 Jean*0104       xBump = xgOrigin + delX(1)*64.
                0105       yBump = ygOrigin   + delY(1)*11.5
1b23894ba3 Jean*0106       dxBump=  delX(1)*12.
                0107       dyBump=  delY(1)*6.
                0108 C_EqCh: Fix solar insolation with Sun directly overhead on Equator
                0109       tYear = 0.25 _d 0 - 10. _d 0/365. _d 0
                0110 C_EqCh: end
                0111 
73341d6ce4 Jean*0112 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0113 C-    Set Land-sea mask (in [0,1]) from aim_landFr to fMask1:
                0114       DO j=1,sNy
                0115         DO i=1,sNx
                0116           I2 = i+(j-1)*sNx
                0117           fMask1(I2,1,myThid) = aim_landFr(i,j,bi,bj)
                0118         ENDDO
                0119       ENDDO
                0120 
1b23894ba3 Jean*0121       IF (aim_useFMsurfBC) THEN
                0122 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0123 
717a660aff Jean*0124 C     aim_surfForc_TimePeriod :: Length of forcing time period (e.g. 1 month)
                0125 C     aim_surfForc_NppCycle   :: Number of time period per Cycle (e.g. 12)
                0126 C     aim_surfForc_TransRatio ::
                0127 C-     define how fast the (linear) transition is from one month to the next
                0128 C       = 1                 -> linear between 2 midle month
                0129 C       > TimePeriod/deltaT -> jump from one month to the next one
                0130 
                0131 C--   Calculate weight for linear interpolation between 2 month centers
                0132         t0prd = myTime / aim_surfForc_TimePeriod
                0133         tNcyc = aim_surfForc_NppCycle
                0134         tmprd = t0prd - 0.5 _d 0 + tNcyc
                0135         tmprd = MOD(tmprd,tNcyc)
                0136 C-     indices of previous month (nm0) and next month (nm1):
                0137         nm0 = 1 + INT(tmprd)
                0138 c       nm1 = 1 + MOD(nm0,aim_surfForc_NppCycle)
                0139 C-     interpolation weight:
                0140         dTprd = tmprd - (nm0 - 1)
                0141         aim_sWght1 = 0.5 _d 0+(dTprd-0.5 _d 0)*aim_surfForc_TransRatio
                0142         aim_sWght1 = MAX( 0. _d 0, MIN(1. _d 0, aim_sWght1) )
                0143         aim_sWght0 = 1. _d 0 - aim_sWght1
                0144 
1b23894ba3 Jean*0145 C--   Compute surface forcing at present time (linear Interp in time)
                0146 C     using F.Molteni surface BC form ; fields needed are:
73341d6ce4 Jean*0147 C     1. Sea  Surface temperatures  (in situ Temp. [K])
                0148 C     2. Land Surface temperatures  (in situ Temp. [K])
                0149 C     3. Soil moisture         (between 0-1)
                0150 C     4. Snow depth, Sea Ice : used to compute albedo (=> local arrays)
                0151 C     5. Albedo                (between 0-1)
1b23894ba3 Jean*0152 
717a660aff Jean*0153 C-    Surface Temperature:
1b23894ba3 Jean*0154         DO j=1,sNy
                0155          DO i=1,sNx
                0156           I2 = i+(j-1)*sNx
717a660aff Jean*0157           sst1(I2,myThid) = aim_sWght0*aim_sst0(i,j,bi,bj)
1b23894ba3 Jean*0158      &                    + aim_sWght1*aim_sst1(i,j,bi,bj)
                0159           stl1(I2,myThid) = aim_sWght0*aim_lst0(i,j,bi,bj)
                0160      &                    + aim_sWght1*aim_lst1(i,j,bi,bj)
                0161          ENDDO
                0162         ENDDO
                0163 
                0164 C-    Soil Water availability : (from F.M. INFORC S/R)
                0165         SDEP1 = 70. _d 0
                0166         IDEP2 =  3. _d 0
                0167         SDEP2 = IDEP2*SDEP1
                0168 
                0169         SWWIL2= SDEP2*SWWIL
                0170         RSW   = 1. _d 0/(SDEP1*SWCAP+SDEP2*(SWCAP-SWWIL))
717a660aff Jean*0171 
1b23894ba3 Jean*0172         DO j=1,sNy
                0173          DO i=1,sNx
                0174           I2 = i+(j-1)*sNx
717a660aff Jean*0175           soilw_0 = ( aim_sw10(i,j,bi,bj)
1b23894ba3 Jean*0176      &     +aim_veget(i,j,bi,bj)*
                0177      &      MAX(IDEP2*aim_sw20(i,j,bi,bj)-SWWIL2, 0. _d 0)
717a660aff Jean*0178      &              )*RSW
                0179           soilw_1 = ( aim_sw11(i,j,bi,bj)
1b23894ba3 Jean*0180      &     +aim_veget(i,j,bi,bj)*
                0181      &      MAX(IDEP2*aim_sw21(i,j,bi,bj)-SWWIL2, 0. _d 0)
717a660aff Jean*0182      &              )*RSW
                0183           soilw1(I2,myThid) = aim_sWght0*soilw_0
1b23894ba3 Jean*0184      &                      + aim_sWght1*soilw_1
                0185           soilw1(I2,myThid) = MIN(1. _d 0, soilw1(I2,myThid) )
                0186          ENDDO
                0187         ENDDO
                0188 
                0189 C-    Set snow depth & sea-ice fraction :
                0190         DO j=1,sNy
                0191          DO i=1,sNx
                0192           I2 = i+(j-1)*sNx
                0193           snow1(I2) = aim_sWght0*aim_snw0(i,j,bi,bj)
717a660aff Jean*0194      &              + aim_sWght1*aim_snw1(i,j,bi,bj)
1b23894ba3 Jean*0195           oice1(I2) = aim_sWght0*aim_oic0(i,j,bi,bj)
717a660aff Jean*0196      &              + aim_sWght1*aim_oic1(i,j,bi,bj)
1b23894ba3 Jean*0197          ENDDO
                0198         ENDDO
                0199 
f36c04300b Jean*0200         IF (aim_splitSIOsFx) THEN
                0201 C-    Split Ocean and Sea-Ice surf. temp. ; remove ice-fraction < 1 %
73341d6ce4 Jean*0202 c        oceTfreez = tFreeze - 1.9 _d 0
                0203          oceTfreez = celsius2K - 1.9 _d 0
f36c04300b Jean*0204          DO J=1,NGP
717a660aff Jean*0205           sti1(J,myThid) = sst1(J,myThid)
f36c04300b Jean*0206           IF ( oice1(J) .GT. 1. _d -2 ) THEN
73341d6ce4 Jean*0207             sst1(J,myThid) = MAX(sst1(J,myThid),oceTfreez)
717a660aff Jean*0208             sti1(J,myThid) = sst1(J,myThid)
f36c04300b Jean*0209      &                     +(sti1(J,myThid)-sst1(J,myThid))/oice1(J)
                0210           ELSE
                0211             oice1(J) = 0. _d 0
                0212           ENDIF
                0213          ENDDO
                0214         ELSE
                0215          DO J=1,NGP
717a660aff Jean*0216           sti1(J,myThid) = sst1(J,myThid)
f36c04300b Jean*0217          ENDDO
                0218         ENDIF
                0219 
1b23894ba3 Jean*0220 C-    Surface Albedo : (from F.M. FORDATE S/R)
f36c04300b Jean*0221 c_FM    DALB=ALBICE-ALBSEA
1b23894ba3 Jean*0222         RSD=1. _d 0/SDALB
486e38797b Jean*0223         ALPHA= 2. _d 0*PI*(TYEAR+10. _d 0/365. _d 0)
f23a68699b Jean*0224 #ifdef ALLOW_INSOLATION
                0225         ZS = - SIN(OBLIQ * deg2rad) * COS(ALPHA)
                0226         ZC =   ASIN( ZS )
                0227         ZC =   COS(ZC)
                0228 #else /* ALLOW_INSOLATION */
486e38797b Jean*0229         RZEN = COS(ALPHA) * ( -23.45 _d 0 * deg2rad)
                0230         ZC = COS(RZEN)
                0231         ZS = SIN(RZEN)
f23a68699b Jean*0232 #endif /* ALLOW_INSOLATION */
1b23894ba3 Jean*0233         DO j=1,sNy
                0234          DO i=1,sNx
                0235 c_FM      SNOWC=MIN(1.,RSD*SNOW1(I,J))
                0236 c_FM      ALBL=ALB0(I,J)+MAX(ALBSN-ALB0(I,J),0.0)*SNOWC
                0237 c_FM      ALBS=ALBSEA+DALB*OICE1(I,J)
                0238 c_FM      ALB1(I,J)=FMASK1(I,J)*ALBL+FMASK0(I,J)*ALBS
                0239           I2 = i+(j-1)*sNx
                0240           alb_land = aim_albedo(i,j,bi,bj)
                0241      &       + MAX( 0. _d 0, ALBSN-aim_albedo(i,j,bi,bj) )
                0242      &        *MIN( 1. _d 0, RSD*snow1(I2))
f36c04300b Jean*0243 c         alb_sea  = ALBSEA + DALB*oice1(I2)
717a660aff Jean*0244 c         alb1(I2,0,myThid) = alb_sea
f36c04300b Jean*0245 c    &        + (alb_land - alb_sea)*fMask1(I2,1,myThid)
486e38797b Jean*0246           ALBSEA1 = ALBSEA
                0247           IF ( aim_selectOceAlbedo .EQ. 1) THEN
                0248            SJ = SIN(yC(i,j,bi,bj) * deg2rad)
                0249            CJ = COS(yC(i,j,bi,bj) * deg2rad)
                0250            TMPA = SJ*ZS
                0251            TMPB = CJ*ZC
                0252            TMPL = -TMPA/TMPB
                0253            IF (TMPL .GE. 1.0 _d 0) THEN
                0254             CZEN = 0.0 _d 0
                0255            ELSEIF (TMPL .LE. -1.0 _d 0) THEN
                0256             CZEN = (2.0 _d 0)*TMPA*PI
                0257             CZEN2= PI*((2.0 _d 0)*TMPA*TMPA + TMPB*TMPB)
                0258             CZEN = CZEN2/CZEN
                0259            ELSE
                0260             hlim = ACOS(TMPL)
                0261             CZEN = 2.0 _d 0*(TMPA*hlim + TMPB*SIN(hlim))
                0262             CZEN2= 2.0 _d 0*TMPA*TMPA*hlim
                0263      &          + 4.0 _d 0*TMPA*TMPB*SIN(hlim)
                0264      &          + TMPB*TMPB*( hlim + 0.5 _d 0*SIN(2.0 _d 0*hlim) )
                0265             CZEN = CZEN2/CZEN
                0266            ENDIF
                0267            ALBSEA1 = ( ( 2.6 _d 0 / (CZEN**(1.7 _d 0) + 0.065 _d 0) )
                0268      &          + ( 15. _d 0 * (CZEN-0.1 _d 0) * (CZEN-0.5 _d 0)
                0269      &          * (CZEN-1.0 _d 0) ) ) / 100.0 _d 0
                0270           ENDIF
f36c04300b Jean*0271           alb1(I2,1,myThid) = alb_land
486e38797b Jean*0272 C_DE      alb1(I2,2,myThid) = ALBSEA
                0273           alb1(I2,2,myThid) = 0.5 _d 0 * ALBSEA
                0274      &        + 0.5 _d 0 * ALBSEA1
f36c04300b Jean*0275           alb1(I2,3,myThid) = ALBICE
1b23894ba3 Jean*0276          ENDDO
                0277         ENDDO
                0278 
                0279 C-- else aim_useFMsurfBC
                0280       ELSE
                0281 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0282 
717a660aff Jean*0283 C-    safer to initialise output argument aim_sWght0,1
                0284 C     even if they are not used when aim_useFMsurfBC=F
                0285         aim_sWght1 = 0. _d 0
                0286         aim_sWght0 = 1. _d 0
                0287 
1b23894ba3 Jean*0288 C-    Set surface forcing fields needed by atmos. physics package
                0289 C     1. Albedo                (between 0-1)
                0290 C     2. Sea  Surface temperatures  (in situ Temp. [K])
                0291 C     3. Land Surface temperatures  (in situ Temp. [K])
                0292 C     4. Soil moisture         (between 0-1)
717a660aff Jean*0293 C        Snow depth, Sea Ice (<- no need for now)
1b23894ba3 Jean*0294 
                0295 C      Set surface albedo data (in [0,1]) from aim_albedo to alb1 :
                0296        IF (aim_useMMsurfFc) THEN
                0297         DO j=1,sNy
                0298          DO i=1,sNx
                0299           I2 = i+(j-1)*sNx
f36c04300b Jean*0300           alb1(I2,1,myThid) = aim_albedo(i,j,bi,bj)
                0301           alb1(I2,2,myThid) = aim_albedo(i,j,bi,bj)
                0302           alb1(I2,3,myThid) = aim_albedo(i,j,bi,bj)
1b23894ba3 Jean*0303          ENDDO
                0304         ENDDO
                0305        ELSE
                0306         DO j=1,sNy
                0307          DO i=1,sNx
                0308           I2 = i+(j-1)*sNx
f36c04300b Jean*0309           alb1(I2,1,myThid) = 0.
                0310           alb1(I2,2,myThid) = 0.
                0311           alb1(I2,3,myThid) = 0.
1b23894ba3 Jean*0312          ENDDO
                0313         ENDDO
                0314        ENDIF
                0315 C      Set surface temperature data from aim_S/LSurfTemp to sst1 & stl1 :
                0316        IF (aim_useMMsurfFc) THEN
                0317         DO j=1,sNy
                0318          DO i=1,sNx
                0319           I2 = i+(j-1)*sNx
717a660aff Jean*0320           sst1(I2,myThid) = aim_sst0(i,j,bi,bj)
                0321           stl1(I2,myThid) = aim_sst0(i,j,bi,bj)
                0322           sti1(I2,myThid) = aim_sst0(i,j,bi,bj)
1b23894ba3 Jean*0323          ENDDO
                0324         ENDDO
                0325        ELSE
                0326         DO j=1,sNy
                0327          DO i=1,sNx
                0328           I2 = i+(j-1)*sNx
                0329           sst1(I2,myThid) = 300.
                0330           stl1(I2,myThid) = 300.
f36c04300b Jean*0331           sti1(I2,myThid) = 300.
1b23894ba3 Jean*0332 C_EqCh: start
                0333           sst1(I2,myThid) = 280.
f36c04300b Jean*0334      &     +20. _d 0 *exp( -((xC(i,j,bi,bj)-xBump)/dxBump)**2
1b23894ba3 Jean*0335      &                     -((yC(i,j,bi,bj)-yBump)/dyBump)**2 )
                0336           stl1(I2,myThid) = sst1(I2,myThid)
f36c04300b Jean*0337           sti1(I2,myThid) = sst1(I2,myThid)
1b23894ba3 Jean*0338 C_EqCh: end
                0339          ENDDO
                0340         ENDDO
                0341 C_EqCh: start
f36c04300b Jean*0342         IF (myIter.EQ.nIter0) THEN
1b23894ba3 Jean*0343          WRITE(suff,'(I10.10)') myIter
a726ec5e7f Jean*0344          CALL AIM_WRITE_PHYS( 'aim_SST.', suff, 1,sst1,
                0345      &                        1, bi, bj, 1, myIter, myThid )
1b23894ba3 Jean*0346         ENDIF
                0347 C_EqCh: end
                0348        ENDIF
                0349 
717a660aff Jean*0350 C-     Set soil water availability (in [0,1]) from aim_sw10 to soilw1 :
1b23894ba3 Jean*0351        IF (aim_useMMsurfFc) THEN
                0352         DO j=1,sNy
                0353          DO i=1,sNx
                0354           I2 = i+(j-1)*sNx
717a660aff Jean*0355           soilw1(I2,myThid) = aim_sw10(i,j,bi,bj)
1b23894ba3 Jean*0356          ENDDO
                0357         ENDDO
                0358        ELSE
                0359         DO j=1,sNy
                0360          DO i=1,sNx
                0361           I2 = i+(j-1)*sNx
                0362           soilw1(I2,myThid) = 0.
                0363          ENDDO
                0364         ENDDO
                0365        ENDIF
                0366 
717a660aff Jean*0367 C-     Set Snow depth and Sea Ice
1b23894ba3 Jean*0368 C      (not needed here since albedo is loaded from file)
f36c04300b Jean*0369         DO j=1,sNy
                0370          DO i=1,sNx
                0371           I2 = i+(j-1)*sNx
                0372           oice1(I2) = 0.
                0373           snow1(I2) = 0.
                0374          ENDDO
                0375         ENDDO
1b23894ba3 Jean*0376 
                0377 C-- endif/else aim_useFMsurfBC
                0378       ENDIF
                0379 
                0380 #ifdef COMPONENT_MODULE
                0381       IF ( useCoupler ) THEN
717a660aff Jean*0382 C--   take surface data from the ocean component
73341d6ce4 Jean*0383 C     to replace MxL fields (if use sea-ice) or directly AIM SST
                0384         CALL ATM_APPLY_IMPORT(
                0385      I           aim_landFr,
717a660aff Jean*0386      U           sst1(1,myThid), oice1,
                0387      I           myTime, myIter, bi, bj, myThid )
1b23894ba3 Jean*0388       ENDIF
                0389 #endif /* COMPONENT_MODULE */
                0390 
486e38797b Jean*0391 #ifdef ALLOW_AIM_CO2
                0392       DO j=1,sNy
                0393         DO i=1,sNx
                0394            I2 = i+(j-1)*sNx
                0395            aim_CO2(I2,myThid)= atm_pCO2
                0396         ENDDO
                0397       ENDDO
                0398 #ifdef ALLOW_DIAGNOSTICS
                0399       IF ( useDiagnostics ) THEN
                0400          pCO2scl = 1. _d 6
                0401          CALL DIAGNOSTICS_SCALE_FILL( aim_CO2(1,myThid), pCO2scl, 1,
                0402      &                  'aim_pCO2', 1, 1, 3, bi, bj, myThid )
                0403       ENDIF
                0404 #endif /* ALLOW_DIAGNOSTICS */
                0405 #endif /* ALLOW_AIM_CO2 */
                0406 
1b23894ba3 Jean*0407 #ifdef ALLOW_LAND
                0408       IF (useLand) THEN
                0409 C-    Use land model output instead of prescribed Temp & moisture
717a660aff Jean*0410         CALL AIM_LAND2AIM(
f36c04300b Jean*0411      I           aim_landFr, aim_veget, aim_albedo, snow1,
717a660aff Jean*0412      U           stl1(1,myThid), soilw1(1,myThid), alb1(1,1,myThid),
                0413      I           myTime, myIter, bi, bj, myThid )
1b23894ba3 Jean*0414       ENDIF
                0415 #endif /* ALLOW_LAND */
                0416 
73341d6ce4 Jean*0417 #ifdef ALLOW_THSICE
                0418       IF (useThSIce) THEN
                0419 C-    Use thermo. sea-ice model output instead of prescribed Temp & albedo
717a660aff Jean*0420         CALL AIM_SICE2AIM(
73341d6ce4 Jean*0421      I           aim_landFr,
717a660aff Jean*0422      U           sst1(1,myThid), oice1,
                0423      O           sti1(1,myThid), alb1(1,3,myThid),
                0424      I           myTime, myIter, bi, bj, myThid )
73341d6ce4 Jean*0425       ENDIF
                0426 #endif /* ALLOW_THSICE */
                0427 
f36c04300b Jean*0428 C-- set the sea-ice & open ocean fraction :
                0429         DO J=1,NGP
                0430           fMask1(J,3,myThid) =(1. _d 0 - fMask1(J,1,myThid))
                0431      &                        *oice1(J)
717a660aff Jean*0432           fMask1(J,2,myThid) = 1. _d 0 - fMask1(J,1,myThid)
f36c04300b Jean*0433      &                                 - fMask1(J,3,myThid)
                0434         ENDDO
                0435 
                0436 C-- set the mean albedo :
                0437         DO J=1,NGP
                0438           alb1(J,0,myThid) = fMask1(J,1,myThid)*alb1(J,1,myThid)
                0439      &                     + fMask1(J,2,myThid)*alb1(J,2,myThid)
                0440      &                     + fMask1(J,3,myThid)*alb1(J,3,myThid)
                0441         ENDDO
                0442 
73341d6ce4 Jean*0443 C-- initialize surf. temp. change to zero:
                0444         DO k=1,3
                0445          DO J=1,NGP
                0446           dTsurf(J,k,myThid) = 0.
                0447          ENDDO
                0448         ENDDO
                0449 
f36c04300b Jean*0450         IF (.NOT.aim_splitSIOsFx) THEN
                0451          DO J=1,NGP
                0452           fMask1(J,3,myThid) = 0. _d 0
717a660aff Jean*0453           fMask1(J,2,myThid) = 1. _d 0 - fMask1(J,1,myThid)
f36c04300b Jean*0454          ENDDO
                0455         ENDIF
                0456 
1b23894ba3 Jean*0457 #endif /* ALLOW_AIM */
                0458 
                0459       RETURN
                0460       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!