/[MITgcm]/MITgcm/verification/aim.5l_Equatorial_Channel/code/aim_surf_bc.F
ViewVC logotype

Diff of /MITgcm/verification/aim.5l_Equatorial_Channel/code/aim_surf_bc.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by jmc, Sat Jan 24 20:41:25 2004 UTC revision 1.8 by jmc, Thu Jan 21 00:13:14 2010 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "AIM_OPTIONS.h"  #include "AIM_OPTIONS.h"
5    
6        SUBROUTINE AIM_SURF_BC( tYear, myTime, myIter, bi, bj, myThid )  CBOP
7    C     !ROUTINE: AIM_SURF_BC
8    C     !INTERFACE:
9          SUBROUTINE AIM_SURF_BC(
10         U                        tYear,
11         O                        aim_sWght0, aim_sWght1,
12         I                        bi, bj, myTime, myIter, myThid )
13    
14    C     !DESCRIPTION: \bv
15  C     *================================================================*  C     *================================================================*
16  C     | S/R AIM_SURF_BC  C     | S/R AIM_SURF_BC
17  C     | Set surface Boundary Conditions    C     | Set surface Boundary Conditions
18  C     |  for the atmospheric physics package  C     |  for the atmospheric physics package
19  C     *================================================================*  C     *================================================================*
20  c     | was part of S/R FORDATE in Franco Molteni SPEEDY code (ver23).  c     | was part of S/R FORDATE in Franco Molteni SPEEDY code (ver23).
21  C     | For now, surface BC are loaded from files (S/R AIM_FIELDS_LOAD)  C     | For now, surface BC are loaded from files (S/R AIM_FIELDS_LOAD)
22  C     |  and imposed (= surf. forcing).  C     |  and imposed (= surf. forcing).
23  C     | In the future, will add  C     | In the future, will add
24  C     |  a land model and a coupling interface with an ocean GCM  C     |  a land model and a coupling interface with an ocean GCM
25  C     *================================================================*  C     *================================================================*
26    C     \ev
27    
28    C     !USES:
29        IMPLICIT NONE        IMPLICIT NONE
30    
31  C     -------------- Global variables --------------  C     -------------- Global variables --------------
# Line 35  c #include "AIM_GRID.h" Line 46  c #include "AIM_GRID.h"
46  #include "com_forcon.h"  #include "com_forcon.h"
47  #include "com_forcing.h"  #include "com_forcing.h"
48  c #include "com_physvar.h"  c #include "com_physvar.h"
49    #include "AIM_CO2.h"
50    
51  C-- Coupled to the Ocean :  C-- Coupled to the Ocean :
52  #ifdef COMPONENT_MODULE  #ifdef COMPONENT_MODULE
# Line 42  C-- Coupled to the Ocean : Line 54  C-- Coupled to the Ocean :
54  #include "ATMCPL.h"  #include "ATMCPL.h"
55  #endif  #endif
56    
57    C     !INPUT/OUTPUT PARAMETERS:
58  C     == Routine arguments ==  C     == Routine arguments ==
59  C     tYear  - Fraction into year  C     tYear      :: Fraction into year
60  C     myTime - Current time of simulation ( s )  C     aim_sWght0 :: weight for time interpolation of surface BC
61  C     myIter - Current iteration number in simulation  C     aim_sWght1 :: 0/1 = time period before/after the current time
62  C     bi,bj  - Tile index  C     bi,bj      :: Tile indices
63  C     myThid - Number of this instance of the routine  C     myTime     :: Current time of simulation ( s )
64        INTEGER myIter, bi, bj, myThid  C     myIter     :: Current iteration number in simulation
65        _RL tYear, myTime  C     myThid     :: my Thread number Id.
66          _RL     tYear
67          _RL     aim_sWght0, aim_sWght1
68          INTEGER bi, bj
69          _RL     myTime
70          INTEGER myIter, myThid
71    CEOP
72    
73  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
74    C     !FUNCTIONS:
75    C     !LOCAL VARIABLES:
76    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
77    C--   Local Variables originally (Speedy) in common bloc (com_forcing.h):
78    C--   COMMON /FORDAY/ Daily forcing fields (updated in FORDATE)
79    C     oice1      :: sea ice fraction
80    C     snow1      :: snow depth (mm water)
81          _RL     oice1(NGP)
82          _RL     snow1(NGP)
83    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
84  C     == Local variables ==  C     == Local variables ==
85  C     i,j,k,I2      - Loop counters  C     i,j,k,I2,k   :: Loop counters
86        INTEGER i,j,I2        INTEGER i,j,I2,k, nm0
87          _RL t0prd, tNcyc, tmprd, dTprd
88        _RL SDEP1, IDEP2, SDEP2, SWWIL2, RSW, soilw_0, soilw_1        _RL SDEP1, IDEP2, SDEP2, SWWIL2, RSW, soilw_0, soilw_1
89        _RL DALB, RSD, alb_sea, alb_land        _RL RSD, alb_land, oceTfreez, ALBSEA1, ALPHA, CZEN, CZEN2
90          _RL RZEN, ZS, ZC, SJ, CJ, TMPA, TMPB, TMPL, hlim
91    c     _RL DALB, alb_sea
92    #ifdef ALLOW_AIM_CO2
93    #ifdef ALLOW_DIAGNOSTICS
94          _RL pCO2scl
95    #endif
96    #endif /* ALLOW_AIM_CO2 */
97    
98  C_EqCh: start  C_EqCh: start
99        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
100        _RL xBump, yBump, dxBump, dyBump        _RL xBump, yBump, dxBump, dyBump
101        xBump = thetaMin + delX(1)*64.        xBump = xgOrigin + delX(1)*64.
102        yBump = phiMin   + delY(1)*11.5        yBump = ygOrigin   + delY(1)*11.5
103        dxBump=  delX(1)*12.        dxBump=  delX(1)*12.
104        dyBump=  delY(1)*6.        dyBump=  delY(1)*6.
105  C_EqCh: Fix solar insolation with Sun directly overhead on Equator  C_EqCh: Fix solar insolation with Sun directly overhead on Equator
106        tYear = 0.25 _d 0 - 10. _d 0/365. _d 0        tYear = 0.25 _d 0 - 10. _d 0/365. _d 0
107  C_EqCh: end  C_EqCh: end
108    
109    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
110    C-    Set Land-sea mask (in [0,1]) from aim_landFr to fMask1:
111          DO j=1,sNy
112            DO i=1,sNx
113              I2 = i+(j-1)*sNx
114              fMask1(I2,1,myThid) = aim_landFr(i,j,bi,bj)
115            ENDDO
116          ENDDO
117    
118        IF (aim_useFMsurfBC) THEN        IF (aim_useFMsurfBC) THEN
119  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
120    
121    C     aim_surfForc_TimePeriod :: Length of forcing time period (e.g. 1 month)
122    C     aim_surfForc_NppCycle   :: Number of time period per Cycle (e.g. 12)
123    C     aim_surfForc_TransRatio ::
124    C-     define how fast the (linear) transition is from one month to the next
125    C       = 1                 -> linear between 2 midle month
126    C       > TimePeriod/deltaT -> jump from one month to the next one
127    
128    C--   Calculate weight for linear interpolation between 2 month centers
129            t0prd = myTime / aim_surfForc_TimePeriod
130            tNcyc = aim_surfForc_NppCycle
131            tmprd = t0prd - 0.5 _d 0 + tNcyc
132            tmprd = MOD(tmprd,tNcyc)
133    C-     indices of previous month (nm0) and next month (nm1):
134            nm0 = 1 + INT(tmprd)
135    c       nm1 = 1 + MOD(nm0,aim_surfForc_NppCycle)
136    C-     interpolation weight:
137            dTprd = tmprd - (nm0 - 1)
138            aim_sWght1 = 0.5 _d 0+(dTprd-0.5 _d 0)*aim_surfForc_TransRatio
139            aim_sWght1 = MAX( 0. _d 0, MIN(1. _d 0, aim_sWght1) )
140            aim_sWght0 = 1. _d 0 - aim_sWght1
141    
142  C--   Compute surface forcing at present time (linear Interp in time)  C--   Compute surface forcing at present time (linear Interp in time)
143  C     using F.Molteni surface BC form ; fields needed are:  C     using F.Molteni surface BC form ; fields needed are:
144  C     1. Land sea mask    C     1. Sea  Surface temperatures  (in situ Temp. [K])
145  C     2. Sea  Surface temperatures  (in situ Temp. [K])  C     2. Land Surface temperatures  (in situ Temp. [K])
146  C     3. Land Surface temperatures  (in situ Temp. [K])  C     3. Soil moisture         (between 0-1)
147  C     4. Soil moisture         (between 0-1)  C     4. Snow depth, Sea Ice : used to compute albedo (=> local arrays)
148  C     5. Snow depth, Sea Ice : used to compute albedo (=> local arrays)  C     5. Albedo                (between 0-1)
 C     6. Albedo                (between 0-1)  
   
 C-     Set Land-sea mask (in [0,1]) from aim_landFr to fMask1:  
         DO j=1,sNy  
          DO i=1,sNx  
           I2 = i+(j-1)*sNx  
           fMask1(I2,myThid) = aim_landFr(i,j,bi,bj)  
          ENDDO  
         ENDDO  
149    
150  C-    Surface Temperature:  C-    Surface Temperature:
151          DO j=1,sNy          DO j=1,sNy
152           DO i=1,sNx           DO i=1,sNx
153            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
154            sst1(I2,myThid) = aim_sWght0*aim_sst0(i,j,bi,bj)            sst1(I2,myThid) = aim_sWght0*aim_sst0(i,j,bi,bj)
155       &                    + aim_sWght1*aim_sst1(i,j,bi,bj)       &                    + aim_sWght1*aim_sst1(i,j,bi,bj)
156            stl1(I2,myThid) = aim_sWght0*aim_lst0(i,j,bi,bj)            stl1(I2,myThid) = aim_sWght0*aim_lst0(i,j,bi,bj)
157       &                    + aim_sWght1*aim_lst1(i,j,bi,bj)       &                    + aim_sWght1*aim_lst1(i,j,bi,bj)
# Line 107  C-    Soil Water availability : (from F. Line 165  C-    Soil Water availability : (from F.
165    
166          SWWIL2= SDEP2*SWWIL          SWWIL2= SDEP2*SWWIL
167          RSW   = 1. _d 0/(SDEP1*SWCAP+SDEP2*(SWCAP-SWWIL))          RSW   = 1. _d 0/(SDEP1*SWCAP+SDEP2*(SWCAP-SWWIL))
168                                                          
169          DO j=1,sNy          DO j=1,sNy
170           DO i=1,sNx           DO i=1,sNx
171            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
172            soilw_0 = ( aim_sw10(i,j,bi,bj)            soilw_0 = ( aim_sw10(i,j,bi,bj)
173       &     +aim_veget(i,j,bi,bj)*       &     +aim_veget(i,j,bi,bj)*
174       &      MAX(IDEP2*aim_sw20(i,j,bi,bj)-SWWIL2, 0. _d 0)       &      MAX(IDEP2*aim_sw20(i,j,bi,bj)-SWWIL2, 0. _d 0)
175       &              )*RSW       &              )*RSW
176            soilw_1 = ( aim_sw11(i,j,bi,bj)            soilw_1 = ( aim_sw11(i,j,bi,bj)
177       &     +aim_veget(i,j,bi,bj)*       &     +aim_veget(i,j,bi,bj)*
178       &      MAX(IDEP2*aim_sw21(i,j,bi,bj)-SWWIL2, 0. _d 0)       &      MAX(IDEP2*aim_sw21(i,j,bi,bj)-SWWIL2, 0. _d 0)
179       &              )*RSW       &              )*RSW
180            soilw1(I2,myThid) = aim_sWght0*soilw_0            soilw1(I2,myThid) = aim_sWght0*soilw_0
181       &                      + aim_sWght1*soilw_1       &                      + aim_sWght1*soilw_1
182            soilw1(I2,myThid) = MIN(1. _d 0, soilw1(I2,myThid) )            soilw1(I2,myThid) = MIN(1. _d 0, soilw1(I2,myThid) )
183           ENDDO           ENDDO
# Line 130  C-    Set snow depth & sea-ice fraction Line 188  C-    Set snow depth & sea-ice fraction
188           DO i=1,sNx           DO i=1,sNx
189            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
190            snow1(I2) = aim_sWght0*aim_snw0(i,j,bi,bj)            snow1(I2) = aim_sWght0*aim_snw0(i,j,bi,bj)
191       &              + aim_sWght1*aim_snw1(i,j,bi,bj)       &              + aim_sWght1*aim_snw1(i,j,bi,bj)
192            oice1(I2) = aim_sWght0*aim_oic0(i,j,bi,bj)            oice1(I2) = aim_sWght0*aim_oic0(i,j,bi,bj)
193       &              + aim_sWght1*aim_oic1(i,j,bi,bj)       &              + aim_sWght1*aim_oic1(i,j,bi,bj)
194           ENDDO           ENDDO
195          ENDDO          ENDDO
196    
197            IF (aim_splitSIOsFx) THEN
198    C-    Split Ocean and Sea-Ice surf. temp. ; remove ice-fraction < 1 %
199    c        oceTfreez = tFreeze - 1.9 _d 0
200             oceTfreez = celsius2K - 1.9 _d 0
201             DO J=1,NGP
202              sti1(J,myThid) = sst1(J,myThid)
203              IF ( oice1(J) .GT. 1. _d -2 ) THEN
204                sst1(J,myThid) = MAX(sst1(J,myThid),oceTfreez)
205                sti1(J,myThid) = sst1(J,myThid)
206         &                     +(sti1(J,myThid)-sst1(J,myThid))/oice1(J)
207              ELSE
208                oice1(J) = 0. _d 0
209              ENDIF
210             ENDDO
211            ELSE
212             DO J=1,NGP
213              sti1(J,myThid) = sst1(J,myThid)
214             ENDDO
215            ENDIF
216    
217  C-    Surface Albedo : (from F.M. FORDATE S/R)  C-    Surface Albedo : (from F.M. FORDATE S/R)
218          DALB=ALBICE-ALBSEA  c_FM    DALB=ALBICE-ALBSEA
219          RSD=1. _d 0/SDALB          RSD=1. _d 0/SDALB
220            ALPHA= 2. _d 0*PI*(TYEAR+10. _d 0/365. _d 0)
221            RZEN = COS(ALPHA) * ( -23.45 _d 0 * deg2rad)
222            ZC = COS(RZEN)
223            ZS = SIN(RZEN)
224          DO j=1,sNy          DO j=1,sNy
225           DO i=1,sNx           DO i=1,sNx
226  c_FM      SNOWC=MIN(1.,RSD*SNOW1(I,J))  c_FM      SNOWC=MIN(1.,RSD*SNOW1(I,J))
# Line 149  c_FM      ALB1(I,J)=FMASK1(I,J)*ALBL+FMA Line 231  c_FM      ALB1(I,J)=FMASK1(I,J)*ALBL+FMA
231            alb_land = aim_albedo(i,j,bi,bj)            alb_land = aim_albedo(i,j,bi,bj)
232       &       + MAX( 0. _d 0, ALBSN-aim_albedo(i,j,bi,bj) )       &       + MAX( 0. _d 0, ALBSN-aim_albedo(i,j,bi,bj) )
233       &        *MIN( 1. _d 0, RSD*snow1(I2))       &        *MIN( 1. _d 0, RSD*snow1(I2))
234            alb_sea  = ALBSEA + DALB*oice1(I2)  c         alb_sea  = ALBSEA + DALB*oice1(I2)
235            alb1(I2,myThid) = alb_sea  c         alb1(I2,0,myThid) = alb_sea
236       &        + (alb_land - alb_sea)*fMask1(I2,myThid)  c    &        + (alb_land - alb_sea)*fMask1(I2,1,myThid)
237              ALBSEA1 = ALBSEA
238              IF ( aim_selectOceAlbedo .EQ. 1) THEN
239               SJ = SIN(yC(i,j,bi,bj) * deg2rad)
240               CJ = COS(yC(i,j,bi,bj) * deg2rad)
241               TMPA = SJ*ZS
242               TMPB = CJ*ZC
243               TMPL = -TMPA/TMPB
244               IF (TMPL .GE. 1.0 _d 0) THEN
245                CZEN = 0.0 _d 0
246               ELSEIF (TMPL .LE. -1.0 _d 0) THEN
247                CZEN = (2.0 _d 0)*TMPA*PI
248                CZEN2= PI*((2.0 _d 0)*TMPA*TMPA + TMPB*TMPB)
249                CZEN = CZEN2/CZEN
250               ELSE
251                hlim = ACOS(TMPL)
252                CZEN = 2.0 _d 0*(TMPA*hlim + TMPB*SIN(hlim))
253                CZEN2= 2.0 _d 0*TMPA*TMPA*hlim
254         &          + 4.0 _d 0*TMPA*TMPB*SIN(hlim)
255         &          + TMPB*TMPB*( hlim + 0.5 _d 0*SIN(2.0 _d 0*hlim) )
256                CZEN = CZEN2/CZEN
257               ENDIF
258               ALBSEA1 = ( ( 2.6 _d 0 / (CZEN**(1.7 _d 0) + 0.065 _d 0) )
259         &          + ( 15. _d 0 * (CZEN-0.1 _d 0) * (CZEN-0.5 _d 0)
260         &          * (CZEN-1.0 _d 0) ) ) / 100.0 _d 0
261              ENDIF
262              alb1(I2,1,myThid) = alb_land
263    C_DE      alb1(I2,2,myThid) = ALBSEA
264              alb1(I2,2,myThid) = 0.5 _d 0 * ALBSEA
265         &        + 0.5 _d 0 * ALBSEA1
266              alb1(I2,3,myThid) = ALBICE
267           ENDDO           ENDDO
268          ENDDO          ENDDO
269    
# Line 159  C-- else aim_useFMsurfBC Line 271  C-- else aim_useFMsurfBC
271        ELSE        ELSE
272  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
273    
274    C-    safer to initialise output argument aim_sWght0,1
275    C     even if they are not used when aim_useFMsurfBC=F
276            aim_sWght1 = 0. _d 0
277            aim_sWght0 = 1. _d 0
278    
279  C-    Set surface forcing fields needed by atmos. physics package  C-    Set surface forcing fields needed by atmos. physics package
280  C     1. Albedo                (between 0-1)  C     1. Albedo                (between 0-1)
281  C     2. Sea  Surface temperatures  (in situ Temp. [K])  C     2. Sea  Surface temperatures  (in situ Temp. [K])
282  C     3. Land Surface temperatures  (in situ Temp. [K])  C     3. Land Surface temperatures  (in situ Temp. [K])
283  C     4. Soil moisture         (between 0-1)  C     4. Soil moisture         (between 0-1)
284  C     5. Land sea mask  (infer from exact zeros in soil moisture)  C        Snow depth, Sea Ice (<- no need for now)
 C        Snow depth, Sea Ice (<- no need for now)    
285    
286  C      Set surface albedo data (in [0,1]) from aim_albedo to alb1 :  C      Set surface albedo data (in [0,1]) from aim_albedo to alb1 :
287         IF (aim_useMMsurfFc) THEN         IF (aim_useMMsurfFc) THEN
288          DO j=1,sNy          DO j=1,sNy
289           DO i=1,sNx           DO i=1,sNx
290            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
291            alb1(I2,myThid) = aim_albedo(i,j,bi,bj)            alb1(I2,1,myThid) = aim_albedo(i,j,bi,bj)
292              alb1(I2,2,myThid) = aim_albedo(i,j,bi,bj)
293              alb1(I2,3,myThid) = aim_albedo(i,j,bi,bj)
294           ENDDO           ENDDO
295          ENDDO          ENDDO
296         ELSE         ELSE
297          DO j=1,sNy          DO j=1,sNy
298           DO i=1,sNx           DO i=1,sNx
299            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
300            alb1(I2,myThid) = 0.            alb1(I2,1,myThid) = 0.
301              alb1(I2,2,myThid) = 0.
302              alb1(I2,3,myThid) = 0.
303           ENDDO           ENDDO
304          ENDDO          ENDDO
305         ENDIF         ENDIF
# Line 188  C      Set surface temperature data from Line 308  C      Set surface temperature data from
308          DO j=1,sNy          DO j=1,sNy
309           DO i=1,sNx           DO i=1,sNx
310            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
311            sst1(I2,myThid) = aim_surfTemp(i,j,bi,bj)            sst1(I2,myThid) = aim_sst0(i,j,bi,bj)
312            stl1(I2,myThid) = aim_surfTemp(i,j,bi,bj)            stl1(I2,myThid) = aim_sst0(i,j,bi,bj)
313              sti1(I2,myThid) = aim_sst0(i,j,bi,bj)
314           ENDDO           ENDDO
315          ENDDO          ENDDO
316         ELSE         ELSE
# Line 198  C      Set surface temperature data from Line 319  C      Set surface temperature data from
319            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
320            sst1(I2,myThid) = 300.            sst1(I2,myThid) = 300.
321            stl1(I2,myThid) = 300.            stl1(I2,myThid) = 300.
322              sti1(I2,myThid) = 300.
323  C_EqCh: start  C_EqCh: start
324            sst1(I2,myThid) = 280.            sst1(I2,myThid) = 280.
325       &     +20. _d 0 *exp( -((xC(i,j,bi,bj)-xBump)/dxBump)**2         &     +20. _d 0 *exp( -((xC(i,j,bi,bj)-xBump)/dxBump)**2
326       &                     -((yC(i,j,bi,bj)-yBump)/dyBump)**2 )       &                     -((yC(i,j,bi,bj)-yBump)/dyBump)**2 )
327            stl1(I2,myThid) = sst1(I2,myThid)            stl1(I2,myThid) = sst1(I2,myThid)
328              sti1(I2,myThid) = sst1(I2,myThid)
329  C_EqCh: end  C_EqCh: end
330           ENDDO           ENDDO
331          ENDDO          ENDDO
332  C_EqCh: start  C_EqCh: start
333          IF (myIter.EQ.nIter0) THEN          IF (myIter.EQ.nIter0) THEN
334           WRITE(suff,'(I10.10)') myIter           WRITE(suff,'(I10.10)') myIter
335           CALL AIM_WRITE_LOCAL('aim_SST.',suff,1,sst1(1,myThid),           CALL AIM_WRITE_PHYS( 'aim_SST.', suff, 1,sst1,
336       &                                   bi,bj,1,myIter,myThid)       &                        1, bi, bj, 1, myIter, myThid )
337          ENDIF          ENDIF
338  C_EqCh: end  C_EqCh: end
339         ENDIF         ENDIF
340    
341  C-     Set soil water availability (in [0,1]) from aim_soilWater to soilw1 :  C-     Set soil water availability (in [0,1]) from aim_sw10 to soilw1 :
342         IF (aim_useMMsurfFc) THEN         IF (aim_useMMsurfFc) THEN
343          DO j=1,sNy          DO j=1,sNy
344           DO i=1,sNx           DO i=1,sNx
345            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
346            soilw1(I2,myThid) = aim_soilWater(i,j,bi,bj)            soilw1(I2,myThid) = aim_sw10(i,j,bi,bj)
347           ENDDO           ENDDO
348          ENDDO          ENDDO
349         ELSE         ELSE
# Line 232  C-     Set soil water availability (in [ Line 355  C-     Set soil water availability (in [
355          ENDDO          ENDDO
356         ENDIF         ENDIF
357    
358  C-     Set Land-sea mask (in [0,1])  C-     Set Snow depth and Sea Ice
359  C          from aim_landFr to fMask1 (aim_useFMsurfBC)  C      (not needed here since albedo is loaded from file)
 C       or from where soil moisture is exactly zero (aim_useMMsurfFc)  
        IF (aim_useMMsurfFc) THEN  
         DO j=1,sNy  
          DO i=1,sNx  
           I2 = i+(j-1)*sNx  
           fMask1(I2,myThid) = 1.  
           IF ( soilw1(I2,myThid).EQ.0. ) fMask1(I2,myThid) = 0.  
          ENDDO  
         ENDDO  
        ELSE  
360          DO j=1,sNy          DO j=1,sNy
361           DO i=1,sNx           DO i=1,sNx
362            I2 = i+(j-1)*sNx            I2 = i+(j-1)*sNx
363            fMask1(I2,myThid) = 0.            oice1(I2) = 0.
364              snow1(I2) = 0.
365           ENDDO           ENDDO
366          ENDDO          ENDDO
        ENDIF  
   
 C-     Set Snow depth and Sea Ice  
 C      (not needed here since albedo is loaded from file)  
 c       DO j=1,sNy  
 c        DO i=1,sNx  
 c         I2 = i+(j-1)*sNx  
 c         oice1(I2,myThid) = 0.  
 c         snow1(I2,myThid) = 0.  
 c        ENDDO  
 c       ENDDO  
367    
368  C-- endif/else aim_useFMsurfBC  C-- endif/else aim_useFMsurfBC
369        ENDIF        ENDIF
370    
371  #ifdef COMPONENT_MODULE  #ifdef COMPONENT_MODULE
372        IF ( useCoupler ) THEN        IF ( useCoupler ) THEN
373         IF ( useImportSST ) THEN  C--   take surface data from the ocean component
374          DO J=1,sNy  C     to replace MxL fields (if use sea-ice) or directly AIM SST
375           DO I=1,sNx          CALL ATM_APPLY_IMPORT(
376         I           aim_landFr,
377  c         IF ( SSTocn(I,J,bi,bj) .NE. 0. ) THEN       U           sst1(1,myThid), oice1,
378            IF ( aim_landFr(i,j,bi,bj) .LT. 1. ) THEN       I           myTime, myIter, bi, bj, myThid )
            I2 = (sNx)*(J-1)+I  
 C--   take SST from the ocean compon. where Sea-Ice fraction is zero  
            IF ( oice1(I2).EQ.0. ) THEN  
             sst1(I2,myThid) = SSTocn(i,j,bi,bj)+celsius2K  
 C--   take SST from the ocean compon. if clearly warmer than freezing  
 C       and reset sea-ice fraction & albedo  
            ELSEIF ( SSTocn(i,j,bi,bj).GE. -1. _d 0)  THEN  
             sst1(I2,myThid) = SSTocn(i,j,bi,bj)+celsius2K  
             IF (aim_useFMsurfBC) THEN  
              oice1(I2) = 0.  
              IF (aim_landFr(i,j,bi,bj).EQ. 0.) THEN  
               alb1(I2,myThid) = ALBSEA  
              ELSE  
 C- note: this part never used with current coupled set-up (only full cell  
 C        land / sea)  
               alb_land = aim_albedo(i,j,bi,bj)  
      &        + MAX( 0. _d 0, ALBSN-aim_albedo(i,j,bi,bj) )  
      &         *MIN( 1. _d 0, RSD*snow1(I2))  
               alb_sea  = ALBSEA + DALB*oice1(I2)  
               alb1(I2,myThid) = alb_sea  
      &         + (alb_land - alb_sea)*fMask1(I2,myThid)  
              ENDIF  
             ENDIF  
            ENDIF  
           ENDIF  
   
          ENDDO  
         ENDDO  
        ENDIF  
379        ENDIF        ENDIF
380  #endif /* COMPONENT_MODULE */  #endif /* COMPONENT_MODULE */
381    
382    #ifdef ALLOW_AIM_CO2
383          DO j=1,sNy
384            DO i=1,sNx
385               I2 = i+(j-1)*sNx
386               aim_CO2(I2,myThid)= atm_pCO2
387            ENDDO
388          ENDDO
389    #ifdef ALLOW_DIAGNOSTICS
390          IF ( useDiagnostics ) THEN
391             pCO2scl = 1. _d 6
392             CALL DIAGNOSTICS_SCALE_FILL( aim_CO2(1,myThid), pCO2scl, 1,
393         &                  'aim_pCO2', 1, 1, 3, bi, bj, myThid )
394          ENDIF
395    #endif /* ALLOW_DIAGNOSTICS */
396    #endif /* ALLOW_AIM_CO2 */
397    
398  #ifdef ALLOW_LAND  #ifdef ALLOW_LAND
399        IF (useLand) THEN        IF (useLand) THEN
400  C-    Use land model output instead of prescribed Temp & moisture  C-    Use land model output instead of prescribed Temp & moisture
401          CALL AIM_LAND2AIM( myTime, myIter, bi, bj, myThid )          CALL AIM_LAND2AIM(
402         I           aim_landFr, aim_veget, aim_albedo, snow1,
403         U           stl1(1,myThid), soilw1(1,myThid), alb1(1,1,myThid),
404         I           myTime, myIter, bi, bj, myThid )
405        ENDIF        ENDIF
406  #endif /* ALLOW_LAND */  #endif /* ALLOW_LAND */
407    
408    #ifdef ALLOW_THSICE
409          IF (useThSIce) THEN
410    C-    Use thermo. sea-ice model output instead of prescribed Temp & albedo
411            CALL AIM_SICE2AIM(
412         I           aim_landFr,
413         U           sst1(1,myThid), oice1,
414         O           sti1(1,myThid), alb1(1,3,myThid),
415         I           myTime, myIter, bi, bj, myThid )
416          ENDIF
417    #endif /* ALLOW_THSICE */
418    
419    C-- set the sea-ice & open ocean fraction :
420            DO J=1,NGP
421              fMask1(J,3,myThid) =(1. _d 0 - fMask1(J,1,myThid))
422         &                        *oice1(J)
423              fMask1(J,2,myThid) = 1. _d 0 - fMask1(J,1,myThid)
424         &                                 - fMask1(J,3,myThid)
425            ENDDO
426    
427    C-- set the mean albedo :
428            DO J=1,NGP
429              alb1(J,0,myThid) = fMask1(J,1,myThid)*alb1(J,1,myThid)
430         &                     + fMask1(J,2,myThid)*alb1(J,2,myThid)
431         &                     + fMask1(J,3,myThid)*alb1(J,3,myThid)
432            ENDDO
433    
434    C-- initialize surf. temp. change to zero:
435            DO k=1,3
436             DO J=1,NGP
437              dTsurf(J,k,myThid) = 0.
438             ENDDO
439            ENDDO
440    
441            IF (.NOT.aim_splitSIOsFx) THEN
442             DO J=1,NGP
443              fMask1(J,3,myThid) = 0. _d 0
444              fMask1(J,2,myThid) = 1. _d 0 - fMask1(J,1,myThid)
445             ENDDO
446            ENDIF
447    
448  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
449    
450        RETURN        RETURN
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22