/[MITgcm]/MITgcm_contrib/verification_other/offline_cheapaml/code/cheapaml.F
ViewVC logotype

Diff of /MITgcm_contrib/verification_other/offline_cheapaml/code/cheapaml.F

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

revision 1.1 by jmc, Wed May 22 19:39:51 2013 UTC revision 1.3 by jmc, Tue Jun 11 01:57:46 2013 UTC
# Line 24  C       --------- Line 24  C       ---------
24  C  C
25  C       Input:  C       Input:
26  C       ------  C       ------
27  C       uwind, vwind  - mean wind speed (m/s)  C       uWind, vWind  - mean wind speed (m/s)
28  C       Tr - Relaxation profile for Tair on boundaries (C)  C       Tr - Relaxation profile for Tair on boundaries (C)
29  C       qr - Relaxation profile for specific humidity (kg/kg)  C       qr - Relaxation profile for specific humidity (kg/kg)
30  C       CheaptracerR - Relaxation profile for passive tracer  C       CheaptracerR - Relaxation profile for passive tracer
# Line 47  C     == global variables == Line 47  C     == global variables ==
47  C     == routine arguments ==  C     == routine arguments ==
48        _RL     myTime        _RL     myTime
49        INTEGER myIter        INTEGER myIter
50        INTEGER mythid        INTEGER myThid
51    
52  C     == Local variables ==  C     == Local variables ==
53        INTEGER bi,bj        INTEGER bi,bj
# Line 67  C zonal and meridional transports Line 67  C zonal and meridional transports
67          _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68  C       AML timestep  C       AML timestep
69          _RL deltaTTracer,deltaTm,ts,xalwu          _RL deltaTTracer,deltaTm,ts,xalwu
 c       _RL dm,pt,fsha,flha,evp,xalwd,xolw,xlwnet  
70          _RL dm,pt,xalwd,xlwnet          _RL dm,pt,xalwd,xlwnet
71          _RL dtemp,xflu,xfld,dq,dtr          _RL dtemp,xflu,xfld,dq,dtr
72  c       _RL Fclouds, ttt2  c       _RL Fclouds, ttt2
 c       _RL q,precip,ssqt,ttt,q100,entrain,cdq  
73          _RL q,precip,ttt,entrain          _RL q,precip,ttt,entrain
74          _RL uRelWind(1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL uRelWind(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75          _RL vRelWind(1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL vRelWind(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
76            _RL windSq  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
77          _RL fsha(1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL fsha(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
78          _RL flha(1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL flha(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
79          _RL evp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL evp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 82  c       _RL q,precip,ssqt,ttt,q100,entra Line 81  c       _RL q,precip,ssqt,ttt,q100,entra
81          _RL ssqt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL ssqt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
82          _RL q100(1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL q100(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
83          _RL cdq (1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL cdq (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84    C     surfDrag   :: surface drag coeff (for wind stress)
85            _RL surfDrag(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
86          _RL dumArg(6)          _RL dumArg(6)
87          _RL fsha0, flha0, evp_0, xolw0, ssqt0, q100_0, cdq_0          _RL fsha0, flha0, evp_0, xolw0, ssqt0, q100_0, cdq_0
88          _RL Tsurf  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)          _RL Tsurf  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 254  C compute advective and diffusive flux d Line 255  C compute advective and diffusive flux d
255            DO j=1-OLy,sNy+OLy            DO j=1-OLy,sNy+OLy
256             DO i=1-OLx,sNx+OLx             DO i=1-OLx,sNx+OLx
257               gTair(i,j,bi,bj)=0. _d 0               gTair(i,j,bi,bj)=0. _d 0
258               uTrans(i,j)=uwind(i,j,bi,bj)               uTrans(i,j)=uWind(i,j,bi,bj)
259               vTrans(i,j)=vwind(i,j,bi,bj)               vTrans(i,j)=vWind(i,j,bi,bj)
260             ENDDO             ENDDO
261            ENDDO            ENDDO
262            CALL GAD_2d_CALC_RHS(            CALL GAD_2d_CALC_RHS(
263       I           bi, bj, 1-OLx,sNx+OLx, 1-OLy,sNy+OLy,       I           bi, bj, 1-OLx,sNx+OLx, 1-OLy,sNy+OLy,
264       I           uTrans, vTrans,       I           uTrans, vTrans,
265       I           uwind, vwind,       I           uWind, vWind,
266       I           cheapaml_kdiff, Tair,       I           cheapaml_kdiff, Tair,
267       I           deltaTtracer, zu, useFluxLimit,       I           deltaTtracer, zu, useFluxLimit,
268       I           cheapamlXperiodic, cheapamlYperiodic,       I           cheapamlXperiodic, cheapamlYperiodic,
269       O           wwind,       O           wWind,
270       U           gTair,       U           gTair,
271       I           myTime, myIter, myThid )       I           myTime, myIter, myThid )
272           startAB = cheapTairStartAB + nt - 1           startAB = cheapTairStartAB + nt - 1
# Line 282  C close bi,bj loops Line 283  C close bi,bj loops
283           ENDDO           ENDDO
284          ENDDO          ENDDO
285  C update edges  C update edges
286          _EXCH_XY_RL(Tair,mythid)          _EXCH_XY_RL(Tair,myThid)
287    
288         IF (useFreshWaterFlux) THEN         IF (useFreshWaterFlux) THEN
289  C do water  C do water
# Line 291  C do water Line 292  C do water
292            DO j=1-OLy,sNy+OLy            DO j=1-OLy,sNy+OLy
293             DO i=1-OLx,sNx+OLx             DO i=1-OLx,sNx+OLx
294               gqair(i,j,bi,bj)=0. _d 0               gqair(i,j,bi,bj)=0. _d 0
295               uTrans(i,j)=uwind(i,j,bi,bj)               uTrans(i,j)=uWind(i,j,bi,bj)
296               vTrans(i,j)=vwind(i,j,bi,bj)               vTrans(i,j)=vWind(i,j,bi,bj)
297             ENDDO             ENDDO
298            ENDDO            ENDDO
299            CALL GAD_2d_CALC_RHS(            CALL GAD_2d_CALC_RHS(
300       I           bi, bj, 1-OLx,sNx+OLx, 1-OLy,sNy+OLy,       I           bi, bj, 1-OLx,sNx+OLx, 1-OLy,sNy+OLy,
301       I           uTrans, vTrans,       I           uTrans, vTrans,
302       I           uwind, vwind,       I           uWind, vWind,
303       I           cheapaml_kdiff, qair,       I           cheapaml_kdiff, qair,
304       I           deltaTtracer, zu, useFluxLimit,       I           deltaTtracer, zu, useFluxLimit,
305       I           cheapamlXperiodic, cheapamlYperiodic,       I           cheapamlXperiodic, cheapamlYperiodic,
306       O           wwind,       O           wWind,
307       U           gqair,       U           gqair,
308       I           myTime, myIter, myThid )       I           myTime, myIter, myThid )
309            startAB = cheapTairStartAB + nt - 1            startAB = cheapTairStartAB + nt - 1
# Line 319  C close bi, bj loops Line 320  C close bi, bj loops
320           ENDDO           ENDDO
321          ENDDO          ENDDO
322  C update edges  C update edges
323          _EXCH_XY_RL(qair,mythid)          _EXCH_XY_RL(qair,myThid)
324         ENDIF         ! if use freshwater         ENDIF         ! if use freshwater
325    
326         IF (useCheapTracer) THEN         IF (useCheapTracer) THEN
# Line 329  C     do tracer Line 330  C     do tracer
330            DO j=1-OLy,sNy+OLy            DO j=1-OLy,sNy+OLy
331             DO i=1-OLx,sNx+OLx             DO i=1-OLx,sNx+OLx
332               gCheaptracer(i,j,bi,bj)=0. _d 0               gCheaptracer(i,j,bi,bj)=0. _d 0
333               uTrans(i,j)=uwind(i,j,bi,bj)               uTrans(i,j)=uWind(i,j,bi,bj)
334               vTrans(i,j)=vwind(i,j,bi,bj)               vTrans(i,j)=vWind(i,j,bi,bj)
335             ENDDO             ENDDO
336            ENDDO            ENDDO
337            CALL GAD_2d_CALC_RHS(            CALL GAD_2d_CALC_RHS(
338       I           bi, bj, 1-OLx,sNx+OLx, 1-OLy,sNy+OLy,       I           bi, bj, 1-OLx,sNx+OLx, 1-OLy,sNy+OLy,
339       I           uTrans, vTrans,       I           uTrans, vTrans,
340       I           uwind, vwind,       I           uWind, vWind,
341       I           cheapaml_kdiff, Cheaptracer,       I           cheapaml_kdiff, Cheaptracer,
342       I           deltaTtracer, zu, useFluxLimit,       I           deltaTtracer, zu, useFluxLimit,
343       I           cheapamlXperiodic, cheapamlYperiodic,       I           cheapamlXperiodic, cheapamlYperiodic,
344       O           wwind,       O           wWind,
345       U           gCheaptracer,       U           gCheaptracer,
346       I           myTime, myIter, myThid )       I           myTime, myIter, myThid )
347            startAB = cheapTracStartAB + nt - 1            startAB = cheapTracStartAB + nt - 1
# Line 357  C     close bi, bj loops Line 358  C     close bi, bj loops
358           ENDDO           ENDDO
359          ENDDO          ENDDO
360  C     update edges  C     update edges
361          _EXCH_XY_RL(Cheaptracer,mythid)          _EXCH_XY_RL(Cheaptracer,myThid)
362         ENDIF                   ! if use tracer         ENDIF                   ! if use tracer
363    
364  C reset boundaries to open boundary profile  C reset boundaries to open boundary profile
# Line 399  C--   end loop on nt (short time-step lo Line 400  C--   end loop on nt (short time-step lo
400  C cycling on short atmospheric time step is now done  C cycling on short atmospheric time step is now done
401    
402  C     now continue with diabatic forcing  C     now continue with diabatic forcing
 c     iMin = 1-OLx  
 c     iMax = sNx+OLx-1  
 c     jMin = 1-OLy  
 c     jMax = sNy+OLy-1  
403        iMin = 1        iMin = 1
404        iMax = sNx        iMax = sNx
405        jMin = 1        jMin = 1
# Line 411  c     jMax = sNy+OLy-1 Line 408  c     jMax = sNy+OLy-1
408        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
409         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
410    
411             DO j = 1-OLy, sNy+OLy
412              DO i = 1-OLx, sNx+OLx
413                surfDrag(i,j,bi,bj) = 0.
414                uRelWind(i,j) = uWind(i,j,bi,bj)-uVel(i,j,1,bi,bj)
415                vRelWind(i,j) = vWind(i,j,bi,bj)-vVel(i,j,1,bi,bj)
416              ENDDO
417             ENDDO
418             DO j = jMin,jMax
419              DO i = iMin,iMax
420                windSq(i,j) = ( uRelWind( i ,j)*uRelWind( i ,j)
421         &                    + uRelWind(i+1,j)*uRelWind(i+1,j)
422         &                    + vRelWind(i, j )*vRelWind(i, j )
423         &                    + vRelWind(i,j+1)*vRelWind(i,j+1)
424         &                    )*0.5 _d 0
425    #ifdef INCONSISTENT_WIND_LOCATION
426                windSq(i,j) = uRelWind(i,j)*uRelWind(i,j)
427         &                  + vRelWind(i,j)*vRelWind(i,j)
428    #endif
429              ENDDO
430             ENDDO
431    
432           IF ( useThSIce ) THEN           IF ( useThSIce ) THEN
433             CALL CHEAPAML_SEAICE(             CALL CHEAPAML_SEAICE(
434       I                    solar(1-OLx,1-OLy,bi,bj),       I                    solar(1-OLx,1-OLy,bi,bj),
435       I                    cheapdlongwave(1-OLx,1-OLy,bi,bj),       I                    cheapdlongwave(1-OLx,1-OLy,bi,bj),
436       I                    uwind(1-OLx,1-OLy,bi,bj),       I                    uWind(1-OLx,1-OLy,bi,bj),
437       I                    vwind(1-OLx,1-OLy,bi,bj), lath,       I                    vWind(1-OLx,1-OLy,bi,bj), lath,
438       O                    fsha, flha, evp, xolw, ssqt, q100, cdq,       O                    fsha, flha, evp, xolw, ssqt, q100, cdq,
439       O                    Tsurf, iceFrac, Qsw(1-OLx,1-OLy,bi,bj),       O                    Tsurf, iceFrac, Qsw(1-OLx,1-OLy,bi,bj),
440       I                    bi, bj, myTime, myIter, myThid )       I                    bi, bj, myTime, myIter, myThid )
441             DO j = jMin,jMax             DO j = jMin,jMax
442              DO i = iMin,iMax              DO i = iMin,iMax
               uRelWind(i,j) = uwind(i,j,bi,bj)-uVel(i,j,1,bi,bj)  
               vRelWind(i,j) = vwind(i,j,bi,bj)-vVel(i,j,1,bi,bj)  
443                CALL CHEAPAML_COARE3_FLUX(                CALL CHEAPAML_COARE3_FLUX(
444       I                      i, j, bi, bj, 0,       I                      i, j, bi, bj, 0,
445       I                      theta(1-OLx,1-OLy,1,bi,bj),       I                      theta(1-OLx,1-OLy,1,bi,bj), windSq,
446       I                      uRelWind, vRelWind,       O                      fsha0, flha0, evp_0, xolw0,
447       O                      fsha0, flha0, evp_0,       O                      ssqt0, q100_0, cdq_0,
448       O                      xolw0, ssqt0, q100_0, cdq_0,       O                      surfDrag(i,j,bi,bj),
449       O                      dumArg(1), dumArg(2), dumArg(3), dumArg(4),       O                      dumArg(1), dumArg(2), dumArg(3), dumArg(4),
450       I                      myIter, myThid )       I                      myIter, myThid )
451                Qnet(i,j,bi,bj) = (                Qnet(i,j,bi,bj) = (
# Line 462  C-     Qsw (from FFIELDS.h) has opposite Line 478  C-     Qsw (from FFIELDS.h) has opposite
478       O                      fsha(i,j), flha(i,j), evp(i,j),       O                      fsha(i,j), flha(i,j), evp(i,j),
479       O                      xolw(i,j), ssqt(i,j), q100(i,j) )       O                      xolw(i,j), ssqt(i,j), q100(i,j) )
480               ELSEIF (FluxFormula.EQ.'COARE3') THEN               ELSEIF (FluxFormula.EQ.'COARE3') THEN
               uRelWind(i,j) = uwind(i,j,bi,bj)-uVel(i,j,1,bi,bj)  
               vRelWind(i,j) = vwind(i,j,bi,bj)-vVel(i,j,1,bi,bj)  
481                CALL CHEAPAML_COARE3_FLUX(                CALL CHEAPAML_COARE3_FLUX(
482       I                      i, j, bi, bj, 0,       I                      i, j, bi, bj, 0,
483       I                      theta(1-OLx,1-OLy,1,bi,bj),       I                      theta(1-OLx,1-OLy,1,bi,bj), windSq,
484       I                      uRelWind, vRelWind,       O                      fsha(i,j), flha(i,j), evp(i,j), xolw(i,j),
485       O                      fsha(i,j), flha(i,j), evp(i,j),       O                      ssqt(i,j), q100(i,j), cdq(i,j),
486       O                      xolw(i,j), ssqt(i,j), q100(i,j), cdq(i,j),       O                      surfDrag(i,j,bi,bj),
487       O                      dumArg(1), dumArg(2), dumArg(3), dumArg(4),       O                      dumArg(1), dumArg(2), dumArg(3), dumArg(4),
488       I                      myIter, myThid )       I                      myIter, myThid )
489               ENDIF               ENDIF
# Line 484  C-     Qsw (from FFIELDS.h) has opposite Line 498  C-     Qsw (from FFIELDS.h) has opposite
498            DO i = iMin,iMax            DO i = iMin,iMax
499    
500  C atmospheric upwelled long wave  C atmospheric upwelled long wave
501             ttt = Tair(i,j,bi,bj)-gamma_blk*(cheaphgrid(i,j,bi,bj)-zt)             ttt = Tair(i,j,bi,bj)-gamma_blk*(CheapHgrid(i,j,bi,bj)-zt)
502  c          xalwu = stefan*(ttt+celsius2K)**4*0.5 _d 0  c          xalwu = stefan*(ttt+celsius2K)**4*0.5 _d 0
503             xalwu = stefan*(0.5*Tair(i,j,bi,bj)+0.5*ttt+celsius2K)**4             xalwu = stefan*(0.5*Tair(i,j,bi,bj)+0.5*ttt+celsius2K)**4
504       &            *0.5 _d 0       &                   *0.5 _d 0
505  C atmospheric downwelled long wave  C atmospheric downwelled long wave
506             xalwd = stefan*(Tair(i,j,bi,bj)+celsius2K)**4*0.5 _d 0             xalwd = stefan*(Tair(i,j,bi,bj)+celsius2K)**4*0.5 _d 0
507  C total flux at upper atmospheric layer interface  C total flux at upper atmospheric layer interface
# Line 511  C convert spec humidity in water vapor p Line 525  C convert spec humidity in water vapor p
525       &        + 4.0*0.98 _d 0*stefan*(theta(i,j,1,bi,bj)+celsius2K)**3       &        + 4.0*0.98 _d 0*stefan*(theta(i,j,1,bi,bj)+celsius2K)**3
526       &          *(theta(i,j,1,bi,bj)-Tair(i,j,bi,bj))       &          *(theta(i,j,1,bi,bj)-Tair(i,j,bi,bj))
527    
528  c          xlwnet = xolw-stefan*(theta(i,j,1,bi,bj)+celsius2K)**4.  c            xlwnet = xolw-stefan*(theta(i,j,1,bi,bj)+celsius2K)**4.
529  c     &       *(0.65+11.22*qair(i,j,bi,bj) + 0.25*cheapclouds(i,j,bi,bj)  c     &       *(0.65+11.22*qair(i,j,bi,bj) + 0.25*cheapclouds(i,j,bi,bj)
530  c     &       -8.23*qair(i,j,bi,bj)*cheapclouds(i,j,bi,bj))  c     &       -8.23*qair(i,j,bi,bj)*cheapclouds(i,j,bi,bj))
531             ENDIF             ENDIF
532  C clouds  C clouds
533  c          ttt2=Tair(i,j,bi,bj)-1.5*gamma_blk*cheaphgrid(i,j,bi,bj)  c          ttt2=Tair(i,j,bi,bj)-1.5*gamma_blk*CheapHgrid(i,j,bi,bj)
534  c          Fclouds = stefan*ttt2**4*(0.4*cheapclouds(i,j,bi,bj)+1-0.4)/2  c          Fclouds = stefan*ttt2**4*(0.4*cheapclouds(i,j,bi,bj)+1-0.4)/2
535  c          ttt2=Tair(i,j,bi,bj)-3*gamma_blk*cheaphgrid(i,j,bi,bj)+celsius2K  c          ttt2=Tair(i,j,bi,bj)-3*gamma_blk*CheapHgrid(i,j,bi,bj)+celsius2K
536  c          Fclouds = 0.3*stefan*ttt2**4 + 0.22*xolw*cheapclouds(i,j,bi,bj)  c          Fclouds = 0.3*stefan*ttt2**4 + 0.22*xolw*cheapclouds(i,j,bi,bj)
537  C add flux divergences into atmospheric temperature tendency  C add flux divergences into atmospheric temperature tendency
538             gTair(i,j,bi,bj)= (xfld-xflu)/cheaphgrid(i,j,bi,bj)             gTair(i,j,bi,bj)= (xfld-xflu)/CheapHgrid(i,j,bi,bj)
539             IF ( .NOT.useThSIce ) THEN             IF ( .NOT.useThSIce ) THEN
540              Qnet(i,j,bi,bj) = (              Qnet(i,j,bi,bj) = (
541       &                         -solar(i,j,bi,bj)       &                         -solar(i,j,bi,bj)
# Line 543  C layer top Line 557  C layer top
557  C first, what is the pressure there?  C first, what is the pressure there?
558  C ts is surface atmospheric temperature  C ts is surface atmospheric temperature
559              ts=Tair(i,j,bi,bj)+gamma_blk*zt+celsius2K              ts=Tair(i,j,bi,bj)+gamma_blk*zt+celsius2K
560              pt=p0*(1-gamma_blk*cheaphgrid(i,j,bi,bj)/ts)              pt=p0*(1-gamma_blk*CheapHgrid(i,j,bi,bj)/ts)
561       &         **(gravity/gamma_blk/gasR)       &         **(gravity/gamma_blk/gasR)
562    
563  C factor to compute rainfall from specific humidity  C factor to compute rainfall from specific humidity
564              dm=100.*(p0-pt)*recip_gravity              dm=100.*(p0-pt)*recip_gravity
565  C     Large scale precip  C     Large scale precip
566              precip = 0.              precip = 0.
567              IF ( wwind(i,j,bi,bj).GT.0. .AND.              IF ( wWind(i,j,bi,bj).GT.0. .AND.
568       &           q.GT.ssqt(i,j)*0.7 _d 0 ) THEN       &           q.GT.ssqt(i,j)*0.7 _d 0 ) THEN
569                precip = precip                precip = precip
570       &               + ( (q-ssqt(i,j)*0.7 _d 0)*dm/cheap_pr2 )       &               + ( (q-ssqt(i,j)*0.7 _d 0)*dm/cheap_pr2 )
571       &                 *(wwind(i,j,bi,bj)/0.75 _d -5)**2       &                 *(wWind(i,j,bi,bj)/0.75 _d -5)**2
572              ENDIF              ENDIF
573    
574  C     Convective precip  C     Convective precip
# Line 562  C     Convective precip Line 576  C     Convective precip
576                precip = precip + ((q-ssqt(i,j)*0.9 _d 0)*dm/cheap_pr1)                precip = precip + ((q-ssqt(i,j)*0.9 _d 0)*dm/cheap_pr1)
577              ENDIF              ENDIF
578    
579                cheapPrecip(i,j,bi,bj) = precip*1200/CheapHgrid(i,j,bi,bj)
580              entrain = cdq(i,j)*q*0.25              entrain = cdq(i,j)*q*0.25
581    
582  c           gqair(i,j,bi,bj)=(evp-precip-entrain)/cheaphgrid(i,j,bi,bj)  c           gqair(i,j,bi,bj)=(evp-precip-entrain)/CheapHgrid(i,j,bi,bj)
583              gqair(i,j,bi,bj) = (evp(i,j)-entrain)/cheaphgrid(i,j,bi,bj)              gqair(i,j,bi,bj) = (evp(i,j)-entrain)/CheapHgrid(i,j,bi,bj)
584       &                        /rhoa*maskC(i,j,1,bi,bj)       &                        /rhoa*maskC(i,j,1,bi,bj)
585              EmPmR(i,j,bi,bj) = ( EmPmR(i,j,bi,bj)              EmPmR(i,j,bi,bj) = ( EmPmR(i,j,bi,bj)
586       &                          -precip*1200/cheaphgrid(i,j,bi,bj)       &                          -cheapPrecip(i,j,bi,bj)
587       &                         )*maskC(i,j,1,bi,bj)       &                         )*maskC(i,j,1,bi,bj)
588             ENDIF             ENDIF
589    
# Line 624  C     do implicit time stepping over lan Line 639  C     do implicit time stepping over lan
639          IF ( useDiagnostics ) THEN          IF ( useDiagnostics ) THEN
640           CALL DIAGNOSTICS_FILL( fsha,'CH_SH   ',0,1,2,bi,bj,myThid )           CALL DIAGNOSTICS_FILL( fsha,'CH_SH   ',0,1,2,bi,bj,myThid )
641           CALL DIAGNOSTICS_FILL( flha,'CH_LH   ',0,1,2,bi,bj,myThid )           CALL DIAGNOSTICS_FILL( flha,'CH_LH   ',0,1,2,bi,bj,myThid )
642             CALL DIAGNOSTICS_FILL( q100,'CH_q100 ',0,1,2,bi,bj,myThid )
643             CALL DIAGNOSTICS_FILL( ssqt,'CH_ssqt ',0,1,2,bi,bj,myThid )
644          ENDIF          ENDIF
645  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
646    
# Line 632  C close bi,bj loops Line 649  C close bi,bj loops
649        ENDDO        ENDDO
650    
651  C update edges  C update edges
652         _EXCH_XY_RL(Tair,mythid)         _EXCH_XY_RL(Tair,myThid)
653         _EXCH_XY_RS(Qnet,mythid)         _EXCH_XY_RS(Qnet,myThid)
654        IF (useFreshWaterFlux) THEN        IF (useFreshWaterFlux) THEN
655         _EXCH_XY_RL(qair,mythid)         _EXCH_XY_RL(qair,myThid)
656         _EXCH_XY_RS(EmPmR,mythid)         _EXCH_XY_RS(EmPmR,myThid)
657        ENDIF        ENDIF
658        IF (useCheapTracer) THEN        IF (useCheapTracer) THEN
659         _EXCH_XY_RL(Cheaptracer,mythid)         _EXCH_XY_RL(Cheaptracer,myThid)
660        ENDIF        ENDIF
661        IF (.NOT.useStressOption) THEN        IF (.NOT.useStressOption) THEN
662         CALL EXCH_UV_AGRID_3D_RL( ustress, vstress, .TRUE., 1, myThid )         IF ( FluxFormula.EQ.'COARE3' ) THEN
663            _EXCH_XY_RL( surfDrag, myThid )
664           ELSE
665            CALL EXCH_UV_AGRID_3D_RL( ustress, vstress, .TRUE., 1, myThid )
666           ENDIF
667        ENDIF        ENDIF
668    
669  C reset edges to open boundary profiles  C reset edges to open boundary profiles
# Line 684  c     CALL PLOT_FIELD_XYRS( Qnet, 'S/R C Line 705  c     CALL PLOT_FIELD_XYRS( Qnet, 'S/R C
705    
706        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
707         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
708    
709            IF ( .NOT.useStressOption .AND. FluxFormula.EQ.'COARE3' ) THEN
710             DO j = 1-OLy+1,sNy+OLy
711              DO i = 1-OLx+1,sNx+OLx
712                fu(i,j,bi,bj) = maskW(i,j,1,bi,bj)*0.5 _d 0
713         &          *( surfDrag(i-1,j,bi,bj) + surfDrag(i,j,bi,bj) )
714         &          *( uWind(i,j,bi,bj)-uVel(i,j,1,bi,bj) )
715                fv(i,j,bi,bj) = maskS(i,j,1,bi,bj)*0.5 _d 0
716         &          *( surfDrag(i,j-1,bi,bj) + surfDrag(i,j,bi,bj) )
717         &          *( vWind(i,j,bi,bj)-vVel(i,j,1,bi,bj) )
718              ENDDO
719             ENDDO
720    #ifdef INCONSISTENT_WIND_LOCATION
721             DO j = 1-OLy,sNy+OLy
722              DO i = 1-OLx+1,sNx+OLx
723                fu(i,j,bi,bj) = maskW(i,j,1,bi,bj)*0.5 _d 0
724         &          *( surfDrag(i-1,j,bi,bj)
725         &             *( uWind(i-1,j,bi,bj)-uVel(i-1,j,1,bi,bj) )
726         &           + surfDrag(i,j,bi,bj)
727         &             *( uWind(i,j,bi,bj) - uVel(i,j,1,bi,bj) ) )
728              ENDDO
729             ENDDO
730             DO j = 1-OLy+1,sNy+OLy
731              DO i = 1-OLx,sNx+OLx
732                fv(i,j,bi,bj) = maskS(i,j,1,bi,bj)*0.5 _d 0
733         &          *( surfDrag(i,j-1,bi,bj)
734         &             *( vWind(i,j-1,bi,bj)-vVel(i,j-1,1,bi,bj) )
735         &           + surfDrag(i,j,bi,bj)
736         &             *( vWind(i,j,bi,bj) - vVel(i,j,1,bi,bj) ) )
737              ENDDO
738             ENDDO
739    #endif /* INCONSISTENT_WIND_LOCATION */
740            ELSE
741  Cswd move wind stresses to u and v points  Cswd move wind stresses to u and v points
742           DO j = 1-OLy,sNy+OLy           DO j = 1-OLy,sNy+OLy
743            DO i = 1-OLx+1,sNx+OLx            DO i = 1-OLx+1,sNx+OLx
744              fu(i,j,bi,bj) = maskW(i,j,1,bi,bj)              fu(i,j,bi,bj) = maskW(i,j,1,bi,bj)*0.5 _d 0
745       &          *(ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))*0.5 _d 0       &          *( ustress(i,j,bi,bj) + ustress(i-1,j,bi,bj) )
746            ENDDO            ENDDO
747           ENDDO           ENDDO
748           DO j = 1-OLy+1,sNy+OLy           DO j = 1-OLy+1,sNy+OLy
749            DO i = 1-OLx,sNx+OLx            DO i = 1-OLx,sNx+OLx
750              fv(i,j,bi,bj) = maskS(i,j,1,bi,bj)              fv(i,j,bi,bj) = maskS(i,j,1,bi,bj)*0.5 _d 0
751       &          *(vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))*0.5 _d 0       &          *( vstress(i,j,bi,bj) + vstress(i,j-1,bi,bj) )
752            ENDDO            ENDDO
753           ENDDO           ENDDO
754            ENDIF
755    
756  C--   end bi,bj loops  C--   end bi,bj loops
757         ENDDO         ENDDO
# Line 706  C--   end bi,bj loops Line 761  C--   end bi,bj loops
761    
762  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
763        IF ( useDiagnostics ) THEN        IF ( useDiagnostics ) THEN
764         CALL DIAGNOSTICS_FILL(uwind,  'CH_Uwind',0,1,0,1,1,myThid)         CALL DIAGNOSTICS_FILL(uWind,  'CH_Uwind',0,1,0,1,1,myThid)
765         CALL DIAGNOSTICS_FILL(vwind,  'CH_Vwind',0,1,0,1,1,myThid)         CALL DIAGNOSTICS_FILL(vWind,  'CH_Vwind',0,1,0,1,1,myThid)
766         CALL DIAGNOSTICS_FILL_RS(Qnet,'CH_QNET ',0,1,0,1,1,myThid)         CALL DIAGNOSTICS_FILL_RS(Qnet,'CH_QNET ',0,1,0,1,1,myThid)
767         IF (useFreshWaterFlux)         IF (useFreshWaterFlux) THEN
768       & CALL DIAGNOSTICS_FILL_RS(EmPmR,'CH_EmP  ',0,1,0,1,1,myThid)          CALL DIAGNOSTICS_FILL_RS( EmPmR, 'CH_EmP  ', 0,1,0,1,1,myThid)
769            CALL DIAGNOSTICS_FILL(cheapPrecip,'CH_Prec ',0,1,0,1,1,myThid)
770           ENDIF
771         IF (useCheapTracer) THEN         IF (useCheapTracer) THEN
772          CALL DIAGNOSTICS_FILL(Cheaptracer,'CH_Trace',0,1,0,1,1,myThid)          CALL DIAGNOSTICS_FILL(Cheaptracer,'CH_Trace',0,1,0,1,1,myThid)
773         ENDIF         ENDIF
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22