/[MITgcm]/MITgcm/pkg/thsice/thsice_step_fwd.F
ViewVC logotype

Diff of /MITgcm/pkg/thsice/thsice_step_fwd.F

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

revision 1.2 by jmc, Wed Dec 31 17:44:32 2003 UTC revision 1.3 by jmc, Wed Apr 7 23:40:34 2004 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "THSICE_OPTIONS.h"  #include "THSICE_OPTIONS.h"
5    
6    CBOP
7  C     !ROUTINE: THSICE_STEP_FWD  C     !ROUTINE: THSICE_STEP_FWD
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE THSICE_STEP_FWD(        SUBROUTINE THSICE_STEP_FWD(
10       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
11         I             prcAtm,
12         U             evpAtm, flxSW,
13       I             myTime, myIter, myThid )       I             myTime, myIter, myThid )
14    C     !DESCRIPTION: \bv
15  C     *==========================================================*  C     *==========================================================*
16  C     | SUBROUTINE  THSICE_STEP_FWD              C     | S/R  THSICE_STEP_FWD            
17  C     | o Step Forward Therm-SeaIce model.  C     | o Step Forward Therm-SeaIce model.
18  C     *==========================================================*  C     *==========================================================*
19    C     \ev
20    
21  C     !USES:  C     !USES:
22        IMPLICIT NONE        IMPLICIT NONE
23    
24  C     === Global variables ===  C     === Global variables ===
25  #include "SIZE.h"  #include "SIZE.h"
26  #include "EEPARAMS.h"  #include "EEPARAMS.h"
27  #include "PARAMS.h"  #include "PARAMS.h"
28  #include "FFIELDS.h"  #include "FFIELDS.h"
 #include "DYNVARS.h"  
 #include "GRID.h"  
 #ifdef ALLOW_BULK_FORCE  
 #include "BULKF.h"  
 #endif  
29  #include "THSICE_SIZE.h"  #include "THSICE_SIZE.h"
30  #include "THSICE_PARAMS.h"  #include "THSICE_PARAMS.h"
31  #include "THSICE.h"  #include "THSICE_VARS.h"
32  #include "THSICE_DIAGS.h"  #include "THSICE_TAVE.h"
33    
34  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
35  C     === Routine arguments ===  C     === Routine arguments ===
36  C     myIter :: iteration counter for this thread  C     bi,bj   :: tile indices
37  C     myTime :: time counter for this thread  C   iMin,iMax :: computation domain: 1rst index range
38  C     myThid :: thread number for this instance of the routine.  C   jMin,jMax :: computation domain: 2nd  index range
39    C- input:
40    C     prcAtm  :: total precip from the atmosphere [kg/m2/s]
41    C     evpAtm  :: (Inp) evaporation to the atmosphere [kg/m2/s] (>0 if evaporate)
42    C     flxSW   :: (Inp) short-wave heat flux (+=down): downward comp. only
43    C                      (part.1), becomes net SW flux into ocean (part.2).
44    C- output
45    C     evpAtm  :: (Out) net fresh-water flux (E-P) from the atmosphere [m/s] (+=up)
46    C     flxSW   :: (Out) net surf. heat flux from the atmosphere [W/m2], (+=down)
47    C     myTime  :: time counter for this thread
48    C     myIter  :: iteration counter for this thread
49    C     myThid  :: thread number for this instance of the routine.
50        INTEGER bi,bj        INTEGER bi,bj
51        INTEGER iMin, iMax        INTEGER iMin, iMax
52        INTEGER jMin, jMax        INTEGER jMin, jMax
53          _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54          _RL evpAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55          _RL flxSW (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56        _RL  myTime        _RL  myTime
57        INTEGER myIter        INTEGER myIter
58        INTEGER myThid        INTEGER myThid
59    CEOP
60    
61  #ifdef ALLOW_THSICE  #ifdef ALLOW_THSICE
62  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
63  C     === Local variables ===  C     === Local variables ===
64  C     snowAge       :: snow age (s)  C     snowPr    :: snow precipitation [kg/m2/s]
65  C     albedo        :: surface albedo [0-1]  C     agingTime :: aging time scale (s)
66  C     fSWabs        :: net Short-Wave (+ = down) at surface (W m-2)  C     ageFac    :: snow aging factor [1]
67  C     Fbot          :: the oceanic heat flux already incorporated (ice_therm)  C     albedo    :: surface albedo [0-1]
68  C     flxAtm        :: net heat flux from the atmosphere ( >0 downward)  C     flxAtm    :: net heat flux from the atmosphere (+=down) [W/m2]
69  C     evpAtm        :: evaporation to the atmosphere  C     frwAtm    :: net fresh-water flux (E-P) to the atmosphere  [kg/m2/s]
70  C     frwAtm        :: net fresh-water flux (E-P-R) to the atmosphere (m/s)  C     Fbot      :: the oceanic heat flux already incorporated (ice_therm)
71  C     qleft         :: net heat flux from the ice to the ocean  C     flx2oc    :: net heat flux from the ice to the ocean (+=down) [W/m2]
72  C     ffresh        :: fresh-water flux from the ice to the ocean  C     frw2oc    :: fresh-water flux from the ice to the ocean
73  C     fsalt         :: mass salt flux to the ocean  C     fsalt     :: mass salt flux to the ocean
74    C     frzmltMxL :: ocean mixed-layer freezing/melting potential [W/m2]
75    C     TFrzOce   :: sea-water freezing temperature [oC] (function of S)
76        INTEGER i,j        INTEGER i,j
77        _RL snowAge        _RL snowPr
78          _RL agingTime, ageFac
79        _RL albedo        _RL albedo
80        _RL fSWabs        _RL flxAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
81        _RL qleft, qNewIce        _RL frwAtm
82          _RL flx2oc
83          _RL frw2oc
84        _RL fsalt        _RL fsalt
85        _RL ffresh        _RL TFrzOce, cphm, frzmltMxL
       _RL Tf, cphm, frzmlt  
86        _RL Fbot, esurp        _RL Fbot, esurp
87        _RL flxAtm, evpAtm, frwAtm        _RL opFrac, icFrac
88        _RL openFrac, iceFrac, qicAv        _RL oceV2s, oceTs
       _RL oceHs, oceV2s, oceSs, oceTs  
89        _RL compact, hIce, hSnow, Tsf, Tice(nlyr), qicen(nlyr)        _RL compact, hIce, hSnow, Tsf, Tice(nlyr), qicen(nlyr)
90          _RL tmpflx(0:2), tmpdTs
91    
92        LOGICAL dBug        LOGICAL dBug
93    
94        dBug = .FALSE.        dBug = .FALSE.
95   1010 FORMAT(A,1P4E11.3)   1010 FORMAT(A,1P4E11.3)
96    
97          IF ( buoyancyRelation(1:7) .EQ. 'OCEANIC' ) THEN
98           DO j = jMin, jMax
99            DO i = iMin, iMax
100    c        dBug = ( bi.EQ.3 .AND. i.EQ.15 .AND. j.EQ.15 )
101    
102    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
103    C    part.1 : ice-covered fraction ;
104    C     Solve for surface and ice temperature (implicitly) ; compute surf. fluxes
105    C-------
106             IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
107              icFrac  = iceMask(i,j,bi,bj)
108              TFrzOce = -mu_Tf*sOceMxL(i,j,bi,bj)
109              hIce    = iceHeight(i,j,bi,bj)
110              hSnow   = snowHeight(i,j,bi,bj)
111              Tsf     = Tsrf(i,j,bi,bj)
112              qicen(1)= Qice1(i,j,bi,bj)
113              qicen(2)= Qice2(i,j,bi,bj)
114    
115              CALL THSICE_ALBEDO(
116         I               hIce, hSnow, Tsf, snowAge(i,j,bi,bj),
117         O               albedo,
118         I               myThid )
119              flxSW(i,j) = flxSW(i,j)*(1. _d 0 - albedo)
120    
121              CALL THSICE_SOLVE4TEMP(
122         I          useBulkforce, tmpflx, TFrzOce, hIce, hSnow,
123         U          flxSW(i,j), Tsf, qicen,
124         O          Tice, sHeating(i,j,bi,bj), flxCndBt(i,j,bi,bj),
125         O          tmpdTs, flxAtm(i,j), evpAtm(i,j),
126         I          i,j, bi,bj, myThid)
127    
128    #ifdef SHORTWAVE_HEATING
129    C--    Update Fluxes :
130              opFrac= 1. _d 0-icFrac
131              Qsw(i,j,bi,bj)=-icFrac*flxSW(i,j) +opFrac*Qsw(i,j,bi,bj)
132    #endif
133    C--    Update Sea-Ice state :
134              Tsrf(i,j,bi,bj) =Tsf
135              Tice1(i,j,bi,bj)=Tice(1)
136              Tice2(i,j,bi,bj)=Tice(2)
137              Qice1(i,j,bi,bj)=qicen(1)
138              Qice2(i,j,bi,bj)=qicen(2)
139    #ifdef ALLOW_TIMEAVE
140              ice_albedo_Ave(i,j,bi,bj) = ice_albedo_Ave(i,j,bi,bj)
141         &                              + icFrac*albedo*thSIce_deltaT
142    #endif /*ALLOW_TIMEAVE*/
143             ENDIF
144            ENDDO
145           ENDDO
146          ENDIF
147          dBug = .FALSE.
148    
149    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
150    C    part.2 : ice-covered fraction ;
151    C     change in ice/snow thickness and ice-fraction
152    C     note: can only reduce the ice-fraction but not increase it.
153    C-------
154          agingTime = 50. _d 0 * 86400. _d 0
155          ageFac = 1. _d 0 - thSIce_deltaT/agingTime
156        DO j = jMin, jMax        DO j = jMin, jMax
157         DO i = iMin, iMax         DO i = iMin, iMax
158  c       dBug = ( bi.EQ.3 .AND. i.EQ.13 .AND. j.EQ.13 )  c       dBug = ( bi.EQ.3 .AND. i.EQ.15 .AND. j.EQ.15 )
159    
160            TFrzOce = -mu_Tf*sOceMxL(i,j,bi,bj)
161            oceTs   = tOceMxL(i,j,bi,bj)
162            cphm    = cpwater*rhosw*hOceMxL(i,j,bi,bj)
163            frzmltMxL = (TFrzOce-oceTs)*cphm/ocean_deltaT
164    
         Tf     = -mu_Tf*salt(i,j,1,bi,bj)  
         cphm   = cpwater*rhosw*drF(1)*hFacC(i,j,1,bi,bj)  
         oceTs  = theta(i,j,1,bi,bj)  
         frzmlt = (Tf-oceTs)*cphm/thSIce_deltaT  
         compact= iceMask(i,j,bi,bj)  
         hIce   = iceHeight(i,j,bi,bj)  
         hSnow  = snowHeight(i,j,bi,bj)  
165          Fbot   = 0. _d 0          Fbot   = 0. _d 0
         snow(i,j,bi,bj)     = 0. _d 0  
166          saltFlux(i,j,bi,bj) = 0. _d 0          saltFlux(i,j,bi,bj) = 0. _d 0
167            compact= iceMask(i,j,bi,bj)
168          IF (dBug .AND. (frzmlt.GT.0. .OR. compact.GT.0.) ) THEN  C-------
169            WRITE(6,1010) 'ThSI_FWD:-0- iceMask,hIc,hSn,Qnet=',          IF (dBug .AND. (frzmltMxL.GT.0. .OR. compact.GT.0.) ) THEN
170              WRITE(6,1010) 'ThSI_FWD:-1- iceMask,hIc,hSn,Qnet=',
171       &                  compact, hIce, hSnow, Qnet(i,j,bi,bj)       &                  compact, hIce, hSnow, Qnet(i,j,bi,bj)
172            WRITE(6,1010) 'ThSI_FWD: ocTs,Tf,frzmlt=',            WRITE(6,1010) 'ThSI_FWD: ocTs,TFrzOce,frzmltMxL=',
173       &                            oceTs,Tf,frzmlt       &                            oceTs,TFrzOce,frzmltMxL
174          ENDIF          ENDIF
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
 C    part.1 : ice-covered fraction ;  
 C     can only reduce the ice-fraction but not increase it.  
175  C-------  C-------
176          IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN          IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
177            oceHs   = hfacC(i,j,1,bi,bj)*drF(1)  
178            oceSs   = salt (i,j,1,bi,bj)            oceV2s  = v2ocMxL(i,j,bi,bj)
179            oceV2s  = ( uvel(i,j,1,bi,bj)*uvel(i,j,1,bi,bj)            snowPr  = snowPrc(i,j,bi,bj)
180       &              + uvel(i+1,j,1,bi,bj)*uvel(i+1,j,1,bi,bj)            hIce    = iceHeight(i,j,bi,bj)
181       &              + vvel(i,j+1,1,bi,bj)*vvel(i,j+1,1,bi,bj)            hSnow   = snowHeight(i,j,bi,bj)
      &              + vvel(i,j,1,bi,bj)*vvel(i,j,1,bi,bj) )*0.5 _d 0  
           snowAge = sage(i,j,bi,bj)  
 c         snowAge = thSIce_deltaT  
182            Tsf     = Tsrf(i,j,bi,bj)            Tsf     = Tsrf(i,j,bi,bj)
           Tice(1) = Tice1(i,j,bi,bj)  
           Tice(2) = Tice2(i,j,bi,bj)  
183            qicen(1)= Qice1(i,j,bi,bj)            qicen(1)= Qice1(i,j,bi,bj)
184            qicen(2)= Qice2(i,j,bi,bj)            qicen(2)= Qice2(i,j,bi,bj)
185            CALL THSICE_ALBEDO(hIce,hSnow,Tsf,snowAge,albedo)            flx2oc  = flxSW(i,j)
186            fSWabs = solar(i,j,bi,bj)*(1. _d 0 - albedo)  
187            CALL THSICE_THERM(            CALL THSICE_CALC_THICKN(
188       I          fSWabs, oceHs, oceV2s, oceSs, oceTs,       I          frzmltMxL, TFrzOce, oceTs, oceV2s, snowPr,
189       U          compact, hIce, hSnow, Tsf, Tice, qicen,       I          sHeating(i,j,bi,bj), flxCndBt(i,j,bi,bj), evpAtm(i,j),
190       O          qleft, ffresh, fsalt, Fbot,       U          compact, hIce, hSnow, Tsf, qicen, flx2oc,
191       O          flxAtm, evpAtm,       O          frw2oc, fsalt, Fbot,
192       I          i,j, bi,bj, myThid)       I          dBug, myThid)
193    
194    C- note : snowPr was not supposed to be modified in THSICE_THERM ;
195    C         but to reproduce old results, is reset to zero if Tsf >= 0
196              snowPrc(i,j,bi,bj) = snowPr
197    
198    C--  Snow aging :
199              snowAge(i,j,bi,bj) = thSIce_deltaT
200         &                       + snowAge(i,j,bi,bj)*ageFac
201              IF ( snowPr.GT.0. _d 0 )
202         &      snowAge(i,j,bi,bj) = snowAge(i,j,bi,bj)
203         &          * EXP( -(thSIce_deltaT*snowPr/rhos)/hNewSnowAge )
204    C--
205    
206  C-- Diagnostic of Atmospheric Fluxes over sea-ice :  C-- Diagnostic of Atmospheric Fluxes over sea-ice :
207            frwAtm = evpAtm - snow(i,j,bi,bj)*rhos/rhofw            frwAtm = evpAtm(i,j) - prcAtm(i,j)
208  C note: Any flux of mass (here fresh water) that enter or leave the system  C note: Any flux of mass (here fresh water) that enter or leave the system
209  C       with a non zero energy HAS TO be counted: add snow precip.  C       with a non zero energy HAS TO be counted: add snow precip.
210            flxAtm = flxAtm - Lfresh*snow(i,j,bi,bj)*rhos            flxAtm(i,j) = flxAtm(i,j) - Lfresh*snowPrc(i,j,bi,bj)
211    
212  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
213        IF (dBug) WRITE(6,1010) 'ThSI_FWD: iceFrac,flxAtm,evpAtm,flxSnw=',        IF (dBug) WRITE(6,1010) 'ThSI_FWD: icFrac,flxAtm,evpAtm,flxSnw=',
214       &  iceMask(i,j,bi,bj),flxAtm,evpAtm,-Lfresh*snow(i,j,bi,bj)*rhos       &  iceMask(i,j,bi,bj),flxAtm(i,j),evpAtm(i,j),-Lfresh*snowPr
215        IF (dBug) WRITE(6,1010) 'ThSI_FWD: compact,qleft,fsalt,ffresh=',        IF (dBug) WRITE(6,1010) 'ThSI_FWD: compact,flx2oc,fsalt,frw2oc=',
216       &   compact,qleft,fsalt,ffresh       &   compact,flx2oc,fsalt,frw2oc
217  #ifdef CHECK_ENERGY_CONSERV  #ifdef CHECK_ENERGY_CONSERV
218            iceFrac = iceMask(i,j,bi,bj)            icFrac = iceMask(i,j,bi,bj)
219            CALL THSICE_CHECK_CONSERV( dBug, i, j, bi, bj, 0,            CALL THSICE_CHECK_CONSERV( dBug, i, j, bi, bj, 0,
220       I            iceFrac, compact, hIce, hSnow, qicen,       I            icFrac, compact, hIce, hSnow, qicen,
221       I            qleft, ffresh, fsalt, flxAtm, frwAtm,       I            flx2oc, frw2oc, fsalt, flxAtm(i,j), frwAtm,
222       I            myTime, myIter, myThid )       I            myTime, myIter, myThid )
223  #endif /* CHECK_ENERGY_CONSERV */  #endif /* CHECK_ENERGY_CONSERV */
224  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 148  c         iceMask(i,j,bi,bj)=compact Line 228  c         iceMask(i,j,bi,bj)=compact
228            iceheight(i,j,bi,bj) = hIce            iceheight(i,j,bi,bj) = hIce
229            snowheight(i,j,bi,bj)= hSnow            snowheight(i,j,bi,bj)= hSnow
230            Tsrf(i,j,bi,bj) =Tsf            Tsrf(i,j,bi,bj) =Tsf
           Tice1(i,j,bi,bj)=Tice(1)  
           Tice2(i,j,bi,bj)=Tice(2)  
231            Qice1(i,j,bi,bj)=qicen(1)            Qice1(i,j,bi,bj)=qicen(1)
232            Qice2(i,j,bi,bj)=qicen(2)            Qice2(i,j,bi,bj)=qicen(2)
233    
234  C--    Net fluxes :  C--    Net fluxes :
235            ffresh = ffresh/rhofw            frw2oc = frw2oc + (prcAtm(i,j)-snowPrc(i,j,bi,bj))
236            ffresh = -ffresh-rain(i,j,bi,bj)-runoff(i,j,bi,bj)  C-     weighted average net fluxes:
237            frwAtm =  frwAtm-rain(i,j,bi,bj)-runoff(i,j,bi,bj)            icFrac = iceMask(i,j,bi,bj)
238            iceFrac = iceMask(i,j,bi,bj)            opFrac= 1. _d 0-icFrac
239            openFrac= 1. _d 0-iceFrac            flxAtm(i,j) = icFrac*flxAtm(i,j) - opFrac*Qnet(i,j,bi,bj)
240  #ifdef ALLOW_TIMEAVE            frwAtm =     icFrac*frwAtm + opFrac*rhofw*EmPmR(i,j,bi,bj)
241            ICE_Qnet_AVE(i,j,bi,bj) = ICE_Qnet_AVE(i,j,bi,bj)            Qnet(i,j,bi,bj)=-icFrac*flx2oc +opFrac*Qnet(i,j,bi,bj)
242       &          + ( -iceFrac*flxAtm + openFrac*Qnet(i,j,bi,bj)            EmPmR(i,j,bi,bj)=-icFrac*frw2oc/rhofw+opFrac*EmPmR(i,j,bi,bj)
243       &            )*thSIce_deltaT            saltFlux(i,j,bi,bj)=-icFrac*fsalt
           ICE_FWfx_AVE(i,j,bi,bj) = ICE_FWfx_AVE(i,j,bi,bj)  
      &          + ( iceFrac*frwAtm + openFrac*EmPmR(i,j,bi,bj)  
      &            )*thSIce_deltaT  
           ICE_albedo_AVE(i,j,bi,bj) = ICE_albedo_AVE(i,j,bi,bj)  
      &          + iceFrac*albedo*thSIce_deltaT  
 #endif /*ALLOW_TIMEAVE*/  
           Qnet(i,j,bi,bj)=-iceFrac*qleft + openFrac*Qnet(i,j,bi,bj)  
           EmPmR(i,j,bi,bj)=iceFrac*ffresh+openFrac*EmPmR(i,j,bi,bj)  
           saltFlux(i,j,bi,bj)=-iceFrac*fsalt  
244    
245            IF (dBug) WRITE(6,1010)'ThSI_FWD:-1- compact,hIc,hSn,Qnet=',            IF (dBug) WRITE(6,1010)'ThSI_FWD:-3- compact,hIc,hSn,Qnet=',
246       &                      compact,hIce,hSnow,Qnet(i,j,bi,bj)       &                      compact,hIce,hSnow,Qnet(i,j,bi,bj)
247    
248          ELSEIF (hFacC(i,j,1,bi,bj).gt.0. _d 0) THEN          ELSEIF (hOceMxL(i,j,bi,bj).gt.0. _d 0) THEN
249              flxAtm(i,j) =  -Qnet(i,j,bi,bj)
250  #ifdef ALLOW_TIMEAVE            frwAtm = rhofw*EmPmR(i,j,bi,bj)
251           ICE_Qnet_AVE(i,j,bi,bj) = ICE_Qnet_AVE(i,j,bi,bj)          ELSE
252       &                   +Qnet(i,j,bi,bj)*thSIce_deltaT            flxAtm(i,j) = 0. _d 0
253           ICE_FWfx_AVE(i,j,bi,bj) = ICE_FWfx_AVE(i,j,bi,bj)            frwAtm      = 0. _d 0
      &                   +EmPmR(i,j,bi,bj)*thSIce_deltaT  
 #endif /*ALLOW_TIMEAVE*/  
   
254          ENDIF          ENDIF
255    
256  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
257  C    part.2 : freezing of sea-water  C    part.3 : freezing of sea-water
258  C     over ice-free fraction and what is left from ice-covered fraction  C     over ice-free fraction and what is left from ice-covered fraction
259  C-------  C-------
260          esurp = frzmlt - Fbot*iceMask(i,j,bi,bj)  c       compact= iceMask(i,j,bi,bj)
261            hIce   = iceHeight(i,j,bi,bj)
262            hSnow  = snowHeight(i,j,bi,bj)
263    
264            esurp  = frzmltMxL - Fbot*iceMask(i,j,bi,bj)
265          IF (esurp.GT.0. _d 0) THEN          IF (esurp.GT.0. _d 0) THEN
266            iceFrac = compact            icFrac = compact
267            IF ( compact.GT.0. _d 0 ) THEN            qicen(1)= Qice1(i,j,bi,bj)
268              qicen(1)= Qice1(i,j,bi,bj)            qicen(2)= Qice2(i,j,bi,bj)
269              qicen(2)= Qice2(i,j,bi,bj)            CALL THSICE_EXTEND(
270            ELSE       I               esurp, TFrzOce,
271              qicen(1)= -cpwater*Tmlt1       U               oceTs, compact, hIce, hSnow, qicen,
272       &               + cpice *(Tmlt1-Tf) + Lfresh*(1. _d 0-Tmlt1/Tf)       O               flx2oc, frw2oc, fsalt,
273              qicen(2)= -cpice *Tf + Lfresh       I               dBug, myThid )
           ENDIF  
           qicAv = rhoi*(qicen(1)+qicen(2))*0.5 _d 0  
           CALL THSICE_START( myThid,  
      I             esurp, qicAv, Tf,  
      O             qNewIce, ffresh, fsalt,  
      U             oceTs, compact, hIce, hSnow )  
274  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
275        IF (dBug) WRITE(6,1010) 'ThSI_FWD: compact,qNewIce,fsalt,ffresh='        IF (dBug) WRITE(6,1010) 'ThSI_FWD: compact,flx2oc,fsalt,frw2oc='
276       &                 ,compact,qNewIce,fsalt,ffresh       &                 ,compact,flx2oc,fsalt,frw2oc
277  #ifdef CHECK_ENERGY_CONSERV  #ifdef CHECK_ENERGY_CONSERV
278            flxAtm = 0.            tmpflx(1) = 0.
279            frwAtm = 0.            tmpflx(2) = 0.
280            CALL THSICE_CHECK_CONSERV( dBug, i, j, bi, bj, 1,            CALL THSICE_CHECK_CONSERV( dBug, i, j, bi, bj, 1,
281       I            iceFrac, compact, hIce, hSnow, qicen,       I            icFrac, compact, hIce, hSnow, qicen,
282       I            qNewIce, ffresh, fsalt, flxAtm, frwAtm,       I            flx2oc, frw2oc, fsalt, tmpflx(1), tmpflx(2),
283       I            myTime, myIter, myThid )       I            myTime, myIter, myThid )
284  #endif /* CHECK_ENERGY_CONSERV */  #endif /* CHECK_ENERGY_CONSERV */
285  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
286  C--    Update Sea-Ice state :  C--    Update Sea-Ice state :
287            IF ( compact.GT.0. _d 0 .AND. iceFrac.EQ.0. _d 0) THEN            IF ( compact.GT.0. _d 0 .AND. icFrac.EQ.0. _d 0) THEN
288               Tsrf(i,j,bi,bj)  = Tf               Tsrf(i,j,bi,bj)  = TFrzOce
289               Tice1(i,j,bi,bj) = Tf               Tice1(i,j,bi,bj) = TFrzOce
290               Tice2(i,j,bi,bj) = Tf               Tice2(i,j,bi,bj) = TFrzOce
291               Qice1(i,j,bi,bj) = qicen(1)               Qice1(i,j,bi,bj) = qicen(1)
292               Qice2(i,j,bi,bj) = qicen(2)               Qice2(i,j,bi,bj) = qicen(2)
293            ENDIF            ENDIF
294            iceheight(i,j,bi,bj) = hIce            iceheight(i,j,bi,bj) = hIce
295            snowheight(i,j,bi,bj)= hSnow            snowheight(i,j,bi,bj)= hSnow
296  C--    Net fluxes :  C--    Net fluxes :
297            Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) - qNewIce            Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) - flx2oc
298            EmPmR(i,j,bi,bj)= EmPmR(i,j,bi,bj)- ffresh/rhofw            EmPmR(i,j,bi,bj)= EmPmR(i,j,bi,bj)- frw2oc/rhofw
299            saltFlux(i,j,bi,bj)=saltFlux(i,j,bi,bj) - fsalt            saltFlux(i,j,bi,bj)=saltFlux(i,j,bi,bj) - fsalt
300    
301            IF (dBug) WRITE(6,1010)'ThSI_FWD:-2- compact,hIc,hSn,Qnet=',            IF (dBug) WRITE(6,1010)'ThSI_FWD:-4- compact,hIc,hSn,Qnet=',
302       &                        compact,hIce,hSnow,Qnet(i,j,bi,bj)       &                        compact,hIce,hSnow,Qnet(i,j,bi,bj)
303  C--   - if esurp > 0 : end  C--   - if esurp > 0 : end
304          ENDIF          ENDIF
305    
306          IF ( compact .GT. 0. _d 0 ) THEN          IF ( compact .GT. 0. _d 0 ) THEN
307            iceMask(i,j,bi,bj)=compact            iceMask(i,j,bi,bj)=compact
308            IF ( hSnow .EQ. 0. _d 0 ) sage(i,j,bi,bj) = 0. _d 0            IF ( hSnow .EQ. 0. _d 0 ) snowAge(i,j,bi,bj) = 0. _d 0
309          ELSE          ELSE
310            iceMask(i,j,bi,bj)  = 0. _d 0            iceMask(i,j,bi,bj)  = 0. _d 0
311            iceHeight(i,j,bi,bj)= 0. _d 0            iceHeight(i,j,bi,bj)= 0. _d 0
312            snowHeight(i,j,bi,bj)=0. _d 0            snowHeight(i,j,bi,bj)=0. _d 0
313            sage(i,j,bi,bj)     = 0. _d 0            snowAge(i,j,bi,bj)  = 0. _d 0
314            Tsrf(i,j,bi,bj)     = oceTs            Tsrf(i,j,bi,bj)     = oceTs
315            Tice1(i,j,bi,bj)    = 0. _d 0            Tice1(i,j,bi,bj)    = 0. _d 0
316            Tice2(i,j,bi,bj)    = 0. _d 0            Tice2(i,j,bi,bj)    = 0. _d 0
# Line 254  C--   - if esurp > 0 : end Line 318  C--   - if esurp > 0 : end
318            Qice2(i,j,bi,bj)    = 0. _d 0            Qice2(i,j,bi,bj)    = 0. _d 0
319          ENDIF          ENDIF
320    
321  #ifndef CHECK_ENERGY_CONSERV  C--     Return atmospheric fluxes in evpAtm & flxSW (same sign and units):
322  #ifdef ALLOW_TIMEAVE          evpAtm(i,j) = frwAtm
323            ICE_qleft_AVE(i,j,bi,bj)=ICE_qleft_AVE(i,j,bi,bj)          flxSW (i,j) = flxAtm(i,j)
      &         + ( Qnet(i,j,bi,bj)  
      &            )*thSIce_deltaT  
           ICE_fresh_AVE(i,j,bi,bj)=ICE_fresh_AVE(i,j,bi,bj)  
      &         + ( EmPmR(i,j,bi,bj)  
      &            )*thSIce_deltaT  
           ICE_salFx_AVE(i,j,bi,bj)=ICE_salFx_AVE(i,j,bi,bj)  
      &            +saltFlux(i,j,bi,bj)*thSIce_deltaT  
 #endif /* ALLOW_TIMEAVE */  
 #endif /* CHECK_ENERGY_CONSERV */  
   
324         ENDDO         ENDDO
325        ENDDO        ENDDO
326    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22