/[MITgcm]/MITgcm_contrib/torge/itd/code/seaice_growth.F
ViewVC logotype

Diff of /MITgcm_contrib/torge/itd/code/seaice_growth.F

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

revision 1.13 by torge, Fri Nov 2 19:15:42 2012 UTC revision 1.14 by torge, Mon Dec 10 22:19:49 2012 UTC
# Line 58  C     !FUNCTIONS: Line 58  C     !FUNCTIONS:
58    
59  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
60  C     === Local variables ===  C     === Local variables ===
 #ifdef SEAICE_DEBUG  
 c ToM<<< debug seaice_growth  
 C     msgBuf      :: Informational/error message buffer  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
       CHARACTER*12 msgBufForm  
 c ToM>>>  
 #endif  
61  C  C
62  C unit/sign convention:  C unit/sign convention:
63  C    Within the thermodynamic computation all stocks, except HSNOW,  C    Within the thermodynamic computation all stocks, except HSNOW,
# Line 100  C     number of surface interface layer Line 93  C     number of surface interface layer
93        INTEGER kSurface        INTEGER kSurface
94  C     IT :: ice thickness category index (MULTICATEGORIES and ITD code)  C     IT :: ice thickness category index (MULTICATEGORIES and ITD code)
95        INTEGER IT        INTEGER IT
96        _RL pFac  C     msgBuf      :: Informational/error message buffer
97    #ifdef ALLOW_BALANCE_FLUXES
98          CHARACTER*(MAX_LEN_MBUF) msgBuf
99    #elif (defined (SEAICE_DEBUG))
100          CHARACTER*(MAX_LEN_MBUF) msgBuf
101          CHARACTER*12 msgBufForm
102    #endif
103  C     constants  C     constants
104          _RL pFac
105        _RL tempFrz, ICE2SNOW, SNOW2ICE        _RL tempFrz, ICE2SNOW, SNOW2ICE
106        _RL QI, QS, recip_QI        _RL QI, QS, recip_QI
107        _RL lhSublim        _RL lhSublim
# Line 299  C     Helper variables for diagnostics Line 299  C     Helper variables for diagnostics
299        _RL HFsiGlob        _RL HFsiGlob
300        _RL FWF2HFsiTile(nSx,nSy)        _RL FWF2HFsiTile(nSx,nSy)
301        _RL FWF2HFsiGlob        _RL FWF2HFsiGlob
       CHARACTER*(max_len_mbuf) msgbuf  
302  #endif  #endif
303    
304  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 318  C     avoid unnecessary divisions in loo Line 317  C     avoid unnecessary divisions in loo
317  c#ifdef SEAICE_ITD  c#ifdef SEAICE_ITD
318  CToM this is now set by MULTDIM = nITD in SEAICE_SIZE.h  CToM this is now set by MULTDIM = nITD in SEAICE_SIZE.h
319  C    (see SEAICE_SIZE.h and seaice_readparms.F)  C    (see SEAICE_SIZE.h and seaice_readparms.F)
320  c     SEAICE_multDim = nITD  c     SEAICE_multDim = nITD
321  c#endif  c#endif
322        recip_multDim        = SEAICE_multDim        recip_multDim        = SEAICE_multDim
323        recip_multDim        = ONE / recip_multDim        recip_multDim        = ONE / recip_multDim
# Line 515  C           d_HEFFbyRLX(i,j) = 1. _d 1 * Line 514  C           d_HEFFbyRLX(i,j) = 1. _d 1 *
514              d_HEFFbyRLX(i,j) = 1. _d 1 * siEps              d_HEFFbyRLX(i,j) = 1. _d 1 * siEps
515             ENDIF             ENDIF
516  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
517              AREAITD(I,J,1,bi,bj) = AREAITD(I,J,1,bi,bj)              AREAITD(I,J,1,bi,bj) = AREAITD(I,J,1,bi,bj)
518       &                           +  d_AREAbyRLX(i,j)       &                           +  d_AREAbyRLX(i,j)
519              HEFFITD(I,J,1,bi,bj) = HEFFITD(I,J,1,bi,bj)              HEFFITD(I,J,1,bi,bj) = HEFFITD(I,J,1,bi,bj)
520       &                           +  d_HEFFbyRLX(i,j)       &                           +  d_HEFFbyRLX(i,j)
# Line 540  CADJ STORE area(:,:,bi,bj) = comlev1_bib Line 539  CADJ STORE area(:,:,bi,bj) = comlev1_bib
539          DO J=1,sNy          DO J=1,sNy
540           DO I=1,sNx           DO I=1,sNx
541  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
542            tmpscal2=0. _d 0            tmpscal2=0. _d 0
543            tmpscal3=0. _d 0            tmpscal3=0. _d 0
544            tmpscal2=MAX(-HEFFITD(I,J,IT,bi,bj),0. _d 0)            tmpscal2=MAX(-HEFFITD(I,J,IT,bi,bj),0. _d 0)
545            HEFFITD(I,J,IT,bi,bj)=HEFFITD(I,J,IT,bi,bj)+tmpscal2            HEFFITD(I,J,IT,bi,bj)=HEFFITD(I,J,IT,bi,bj)+tmpscal2
546            d_HEFFbyNEG(I,J)=d_HEFFbyNEG(I,J)+tmpscal2            d_HEFFbyNEG(I,J)=d_HEFFbyNEG(I,J)+tmpscal2
547            tmpscal3=MAX(-HSNOWITD(I,J,IT,bi,bj),0. _d 0)            tmpscal3=MAX(-HSNOWITD(I,J,IT,bi,bj),0. _d 0)
548            HSNOWITD(I,J,IT,bi,bj)=HSNOWITD(I,J,IT,bi,bj)+tmpscal3            HSNOWITD(I,J,IT,bi,bj)=HSNOWITD(I,J,IT,bi,bj)+tmpscal3
549            d_HSNWbyNEG(I,J)=d_HSNWbyNEG(I,J)+tmpscal3            d_HSNWbyNEG(I,J)=d_HSNWbyNEG(I,J)+tmpscal3
550            AREAITD(I,J,IT,bi,bj)=MAX(AREAITD(I,J,IT,bi,bj),0. _d 0)            AREAITD(I,J,IT,bi,bj)=MAX(AREAITD(I,J,IT,bi,bj),0. _d 0)
551  CToM      AREA, HEFF, and HSNOW will be updated at end of PART 1  CToM      AREA, HEFF, and HSNOW will be updated at end of PART 1
552  C         by calling SEAICE_ITD_SUM  C         by calling SEAICE_ITD_SUM
# Line 561  C         by calling SEAICE_ITD_SUM Line 560  C         by calling SEAICE_ITD_SUM
560           ENDDO           ENDDO
561          ENDDO          ENDDO
562  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
563          ENDDO          ENDDO
564  #endif  #endif
565    
566  C 1.25) treat the case of very thin ice:  C 1.25) treat the case of very thin ice:
# Line 570  C 1.25) treat the case of very thin ice: Line 569  C 1.25) treat the case of very thin ice:
569  CADJ STORE heff(:,:,bi,bj)  = comlev1_bibj, key = iicekey,byte=isbyte  CADJ STORE heff(:,:,bi,bj)  = comlev1_bibj, key = iicekey,byte=isbyte
570  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
571  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
572          DO IT=1,nITD          DO IT=1,nITD
573  #endif  #endif
574          DO J=1,sNy          DO J=1,sNy
575           DO I=1,sNx           DO I=1,sNx
576            tmpscal2=0. _d 0            tmpscal2=0. _d 0
577            tmpscal3=0. _d 0            tmpscal3=0. _d 0
578  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
579            IF (HEFFITD(I,J,IT,bi,bj).LE.siEps) THEN            IF (HEFFITD(I,J,IT,bi,bj).LE.siEps) THEN
580             tmpscal2=-HEFFITD(I,J,IT,bi,bj)             tmpscal2=-HEFFITD(I,J,IT,bi,bj)
# Line 618  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi Line 617  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi
617           DO I=1,sNx           DO I=1,sNx
618  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
619            IF ((HEFFITD(I,J,IT,bi,bj).EQ.0. _d 0).AND.            IF ((HEFFITD(I,J,IT,bi,bj).EQ.0. _d 0).AND.
620       &        (HSNOWITD(I,J,IT,bi,bj).EQ.0. _d 0))       &        (HSNOWITD(I,J,IT,bi,bj).EQ.0. _d 0))
621       &     AREAITD(I,J,IT,bi,bj)=0. _d 0       &     AREAITD(I,J,IT,bi,bj)=0. _d 0
622  #else  #else
623            IF ((HEFF(i,j,bi,bj).EQ.0. _d 0).AND.            IF ((HEFF(i,j,bi,bj).EQ.0. _d 0).AND.
# Line 627  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi Line 626  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi
626           ENDDO           ENDDO
627          ENDDO          ENDDO
628  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
629          ENDDO          ENDDO
630  #endif  #endif
631    
632  C 2) treat the case of very small area:  C 2) treat the case of very small area:
# Line 637  C 2) treat the case of very small area: Line 636  C 2) treat the case of very small area:
636  CADJ STORE area(:,:,bi,bj)  = comlev1_bibj, key = iicekey,byte=isbyte  CADJ STORE area(:,:,bi,bj)  = comlev1_bibj, key = iicekey,byte=isbyte
637  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
638  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
639          DO IT=1,nITD          DO IT=1,nITD
640  #endif  #endif
641          DO J=1,sNy          DO J=1,sNy
642           DO I=1,sNx           DO I=1,sNx
# Line 645  CADJ STORE area(:,:,bi,bj)  = comlev1_bi Line 644  CADJ STORE area(:,:,bi,bj)  = comlev1_bi
644            IF ((HEFFITD(I,J,IT,bi,bj).GT.0).OR.            IF ((HEFFITD(I,J,IT,bi,bj).GT.0).OR.
645       &        (HSNOWITD(I,J,IT,bi,bj).GT.0)) THEN       &        (HSNOWITD(I,J,IT,bi,bj).GT.0)) THEN
646  CToM       SEAICE_area_floor*nITD cannot be allowed to exceed 1  CToM       SEAICE_area_floor*nITD cannot be allowed to exceed 1
647  C          hence use SEAICE_area_floor devided by nITD  C          hence use SEAICE_area_floor devided by nITD
648  C          (or install a warning in e.g. seaice_readparms.F)  C          (or install a warning in e.g. seaice_readparms.F)
649             AREAITD(I,J,IT,bi,bj)=             AREAITD(I,J,IT,bi,bj)=
650       &        MAX(AREAITD(I,J,IT,bi,bj),SEAICE_area_floor/float(nITD))       &        MAX(AREAITD(I,J,IT,bi,bj),SEAICE_area_floor/float(nITD))
# Line 658  C          (or install a warning in e.g. Line 657  C          (or install a warning in e.g.
657           ENDDO           ENDDO
658          ENDDO          ENDDO
659  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
660          ENDDO          ENDDO
661  #endif  #endif
662  #endif /* DISABLE_AREA_FLOOR */  #endif /* DISABLE_AREA_FLOOR */
663    
# Line 685  CADJ STORE area(:,:,bi,bj)  = comlev1_bi Line 684  CADJ STORE area(:,:,bi,bj)  = comlev1_bi
684    
685  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
686  CToM catch up with items 1.25 and 2.5 involving category sums AREA and HEFF  CToM catch up with items 1.25 and 2.5 involving category sums AREA and HEFF
687          DO IT=1,nITD          DO IT=1,nITD
688           DO J=1,sNy           DO J=1,sNy
689            DO I=1,sNx            DO I=1,sNx
690  C    TICES was changed above (item 1.25), now update TICE as ice volume  C    TICES was changed above (item 1.25), now update TICE as ice volume
691  C     weighted average of TICES  C     weighted average of TICES
692  C    also compute total of AREAITD (needed for finishing item 2.5, see below)  C    also compute total of AREAITD (needed for finishing item 2.5, see below)
693             IF (IT .eq. 1) THEN             IF (IT .eq. 1) THEN
694              tmpscal1itd(i,j) = 0. _d 0              tmpscal1itd(i,j) = 0. _d 0
695              tmpscal2itd(i,j) = 0. _d 0              tmpscal2itd(i,j) = 0. _d 0
696              tmpscal3itd(i,j) = 0. _d 0              tmpscal3itd(i,j) = 0. _d 0
697             ENDIF             ENDIF
698             tmpscal1itd(i,j)=tmpscal1itd(i,j) + TICES(I,J,IT,bi,bj)             tmpscal1itd(i,j)=tmpscal1itd(i,j) + TICES(I,J,IT,bi,bj)
699       &                                       * HEFFITD(I,J,IT,bi,bj)       &                                       * HEFFITD(I,J,IT,bi,bj)
700             tmpscal2itd(i,j)=tmpscal2itd(i,j) + HEFFITD(I,J,IT,bi,bj)             tmpscal2itd(i,j)=tmpscal2itd(i,j) + HEFFITD(I,J,IT,bi,bj)
701             tmpscal3itd(i,j)=tmpscal3itd(i,j) + AREAITD(I,J,IT,bi,bj)             tmpscal3itd(i,j)=tmpscal3itd(i,j) + AREAITD(I,J,IT,bi,bj)
702             IF (IT .eq. nITD) THEN             IF (IT .eq. nITD) THEN
703              TICE(I,J,bi,bj)=tmpscal1itd(i,j)/tmpscal2itd(i,j)              TICE(I,J,bi,bj)=tmpscal1itd(i,j)/tmpscal2itd(i,j)
704  C    lines of item 2.5 that were omitted:  C    lines of item 2.5 that were omitted:
705  C    in 2.5 these lines are executed before "ridging" is applied to AREA  C    in 2.5 these lines are executed before "ridging" is applied to AREA
706  C    hence we execute them here before SEAICE_ITD_REDIST is called  C    hence we execute them here before SEAICE_ITD_REDIST is called
707  C    although this means that AREA has not been completely regularized  C    although this means that AREA has not been completely regularized
# Line 712  C    although this means that AREA has n Line 711  C    although this means that AREA has n
711  #ifdef ALLOW_SITRACER  #ifdef ALLOW_SITRACER
712              SItrAREA(I,J,bi,bj,1)=tmpscal3itd(i,j)              SItrAREA(I,J,bi,bj,1)=tmpscal3itd(i,j)
713  #endif  #endif
714             ENDIF             ENDIF
715            ENDDO            ENDDO
716           ENDDO           ENDDO
717          ENDDO          ENDDO
# Line 728  C    and update AREA, HEFF, and HSNOW Line 727  C    and update AREA, HEFF, and HSNOW
727  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
728          WRITE(msgBufForm,'(A,I2,A)') '(A,',nITD,'F14.10)'          WRITE(msgBufForm,'(A,I2,A)') '(A,',nITD,'F14.10)'
729  #else  #else
730          WRITE(msgBufForm,'(A,I2,A)') '(A,  F14.10)'          WRITE(msgBufForm,'(A,A)') '(A,  F14.10)'
731  #endif  #endif
732          WRITE(msgBuf,msgBufForm)          WRITE(msgBuf,msgBufForm)
733       &    ' SEAICE_GROWTH: Heff increments 0, HEFF = ',       &    ' SEAICE_GROWTH: Heff increments 0, HEFF = ',
# Line 748  C    and update AREA, HEFF, and HSNOW Line 747  C    and update AREA, HEFF, and HSNOW
747  #endif  #endif
748          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
749       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
750  #endif  #endif /* SEAICE_DEBUG */
751    
752  #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)  #if (defined ALLOW_AUTODIFF_TAMC && defined SEAICE_MODIFY_GROWTH_ADJ)
753  C        end SEAICEadjMODE.EQ.0 statement:  C        end SEAICEadjMODE.EQ.0 statement:
# Line 776  C 3) store regularized values of heff, h Line 775  C 3) store regularized values of heff, h
775          DO IT=1,nITD          DO IT=1,nITD
776           DO J=1,sNy           DO J=1,sNy
777            DO I=1,sNx            DO I=1,sNx
778             HEFFITDpreTH(I,J,IT)=HEFFITD(I,J,IT,bi,bj)             HEFFITDpreTH(I,J,IT)=HEFFITD(I,J,IT,bi,bj)
779             HSNWITDpreTH(I,J,IT)=HSNOWITD(I,J,IT,bi,bj)             HSNWITDpreTH(I,J,IT)=HSNOWITD(I,J,IT,bi,bj)
780             AREAITDpreTH(I,J,IT)=AREAITD(I,J,IT,bi,bj)             AREAITDpreTH(I,J,IT)=AREAITD(I,J,IT,bi,bj)
781    
782  C memorize areal and volume fraction of each ITD category  C memorize areal and volume fraction of each ITD category
783             IF (AREA(I,J,bi,bj) .GT. ZERO) THEN             IF (AREA(I,J,bi,bj) .GT. ZERO) THEN
784              areaFracFactor(I,J,IT)=AREAITD(I,J,IT,bi,bj)/AREA(I,J,bi,bj)              areaFracFactor(I,J,IT)=AREAITD(I,J,IT,bi,bj)/AREA(I,J,bi,bj)
785             ELSE             ELSE
786  C           if there's no ice, potential growth starts in 1st category  C           if there is no ice, potential growth starts in 1st category
787              IF (IT .EQ. 1) THEN              IF (IT .EQ. 1) THEN
788               areaFracFactor(I,J,IT)=ONE               areaFracFactor(I,J,IT)=ONE
789              ELSE              ELSE
790               areaFracFactor(I,J,IT)=ZERO               areaFracFactor(I,J,IT)=ZERO
791              ENDIF              ENDIF
792             ENDIF             ENDIF
793            ENDDO            ENDDO
794           ENDDO           ENDDO
795          ENDDO          ENDDO
# Line 911  CADJ STORE HSNWpreTH = comlev1_bibj, key Line 910  CADJ STORE HSNWpreTH = comlev1_bibj, key
910              heffActualMult(I,J,IT)  = MAX(tmpscal2,SEAICE_hice_reg)              heffActualMult(I,J,IT)  = MAX(tmpscal2,SEAICE_hice_reg)
911  #else /* SEAICE_GROWTH_LEGACY */  #else /* SEAICE_GROWTH_LEGACY */
912  cif        regularize AREA with SEAICE_area_reg  cif        regularize AREA with SEAICE_area_reg
913             tmpscal1 = SQRT(AREAITDpreTH(I,J,IT) * AREAITDpreTH(I,J,IT)             tmpscal1 = SQRT(AREAITDpreTH(I,J,IT) * AREAITDpreTH(I,J,IT)
914       &                     + area_reg_sq)       &                     + area_reg_sq)
915  cif        heffActual calculated with the regularized AREA  cif        heffActual calculated with the regularized AREA
916             tmpscal2 = HEFFITDpreTH(I,J,IT) / tmpscal1             tmpscal2 = HEFFITDpreTH(I,J,IT) / tmpscal1
917  cif        regularize heffActual with SEAICE_hice_reg (add lower bound)  cif        regularize heffActual with SEAICE_hice_reg (add lower bound)
918             heffActualMult(I,J,IT) = SQRT(tmpscal2 * tmpscal2             heffActualMult(I,J,IT) = SQRT(tmpscal2 * tmpscal2
919       &                                  + hice_reg_sq)       &                                  + hice_reg_sq)
920  cif        hsnowActual calculated with the regularized AREA  cif        hsnowActual calculated with the regularized AREA
921             hsnowActualMult(I,J,IT) = HSNWITDpreTH(I,J,IT) / tmpscal1             hsnowActualMult(I,J,IT) = HSNWITDpreTH(I,J,IT) / tmpscal1
922  #endif /* SEAICE_GROWTH_LEGACY */  #endif /* SEAICE_GROWTH_LEGACY */
923  cif        regularize the inverse of heffActual by hice_reg  cif        regularize the inverse of heffActual by hice_reg
924             recip_heffActualMult(I,J,IT)  = AREAITDpreTH(I,J,IT) /             recip_heffActualMult(I,J,IT)  = AREAITDpreTH(I,J,IT) /
925       &                 sqrt(HEFFITDpreTH(I,J,IT) * HEFFITDpreTH(I,J,IT)       &                 sqrt(HEFFITDpreTH(I,J,IT) * HEFFITDpreTH(I,J,IT)
926       &                      + hice_reg_sq)       &                      + hice_reg_sq)
927  cif       Do not regularize when HEFFpreTH = 0  cif       Do not regularize when HEFFpreTH = 0
928            ELSE            ELSE
# Line 1078  C--   Start loop over multi-categories Line 1077  C--   Start loop over multi-categories
1077          DO IT=1,nITD          DO IT=1,nITD
1078           DO J=1,sNy           DO J=1,sNy
1079            DO I=1,sNx            DO I=1,sNx
1080  CToM for SEAICE_ITD heffActualMult and latentHeatFluxMaxMult are calculated above  CToM for SEAICE_ITD heffActualMult and latentHeatFluxMaxMult are calculated above
1081  C    (instead of heffActual and latentHeatFluxMax)  C    (instead of heffActual and latentHeatFluxMax)
1082             ticeInMult(I,J,IT)=TICES(I,J,IT,bi,bj)             ticeInMult(I,J,IT)=TICES(I,J,IT,bi,bj)
1083             ticeOutMult(I,J,IT)=TICES(I,J,IT,bi,bj)             ticeOutMult(I,J,IT)=TICES(I,J,IT,bi,bj)
# Line 1160  CADJ &     comlev1_bibj, key = iicekey, Line 1159  CADJ &     comlev1_bibj, key = iicekey,
1159  C     update TICE & TICES  C     update TICE & TICES
1160  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1161  C     calculate area weighted mean  C     calculate area weighted mean
1162  C     (although the ice's temperature relates to its energy content  C     (although the ice temperature relates to its energy content
1163  C      and hence should be averaged weighted by ice volume,  C      and hence should be averaged weighted by ice volume,
1164  C      the temperature here is a result of the fluxes through the ice surface  C      the temperature here is a result of the fluxes through the ice surface
1165  C      computed individually for each single category in SEAICE_SOLVE4TEMP  C      computed individually for each single category in SEAICE_SOLVE4TEMP
1166  C      and hence is averaged area weighted [areaFracFactor])  C      and hence is averaged area weighted [areaFracFactor])
1167             TICE(I,J,bi,bj) = TICE(I,J,bi,bj)             TICE(I,J,bi,bj) = TICE(I,J,bi,bj)
1168       &          +  ticeOutMult(I,J,IT)*areaFracFactor(I,J,IT)       &          +  ticeOutMult(I,J,IT)*areaFracFactor(I,J,IT)
# Line 1223  CADJ STORE a_FWbySublim    = comlev1_bib Line 1222  CADJ STORE a_FWbySublim    = comlev1_bib
1222    
1223  C switch heat fluxes from W/m2 to 'effective' ice meters  C switch heat fluxes from W/m2 to 'effective' ice meters
1224  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1225          DO IT=1,nITD          DO IT=1,nITD
1226           DO J=1,sNy           DO J=1,sNy
1227            DO I=1,sNx            DO I=1,sNx
1228             a_QbyATMmult_cover(I,J,IT)   = a_QbyATMmult_cover(I,J,IT)             a_QbyATMmult_cover(I,J,IT)   = a_QbyATMmult_cover(I,J,IT)
# Line 1240  C     Negative sublimation is resublimat Line 1239  C     Negative sublimation is resublimat
1239             a_FWbySublimMult(I,J,IT) = SEAICE_deltaTtherm*recip_rhoIce             a_FWbySublimMult(I,J,IT) = SEAICE_deltaTtherm*recip_rhoIce
1240       &            * a_FWbySublimMult(I,J,IT)*AREAITDpreTH(I,J,IT)       &            * a_FWbySublimMult(I,J,IT)*AREAITDpreTH(I,J,IT)
1241             r_FWbySublimMult(I,J,IT)=a_FWbySublimMult(I,J,IT)             r_FWbySublimMult(I,J,IT)=a_FWbySublimMult(I,J,IT)
1242            ENDDO            ENDDO
1243           ENDDO           ENDDO
1244          ENDDO          ENDDO
1245          DO J=1,sNy          DO J=1,sNy
# Line 1296  CADJ STORE r_FWbySublim    = comlev1_bib Line 1295  CADJ STORE r_FWbySublim    = comlev1_bib
1295  Cgf no additional dependency through ice cover  Cgf no additional dependency through ice cover
1296          IF ( SEAICEadjMODE.GE.3 ) THEN          IF ( SEAICEadjMODE.GE.3 ) THEN
1297  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1298           DO IT=1,nITD           DO IT=1,nITD
1299            DO J=1,sNy            DO J=1,sNy
1300             DO I=1,sNx             DO I=1,sNx
1301              a_QbyATMmult_cover(I,J,IT)   = 0. _d 0              a_QbyATMmult_cover(I,J,IT)   = 0. _d 0
# Line 1304  Cgf no additional dependency through ice Line 1303  Cgf no additional dependency through ice
1303              a_QSWbyATMmult_cover(I,J,IT) = 0. _d 0              a_QSWbyATMmult_cover(I,J,IT) = 0. _d 0
1304             ENDDO             ENDDO
1305            ENDDO            ENDDO
1306           ENDDO           ENDDO
1307  #else  #else
1308           DO J=1,sNy           DO J=1,sNy
1309            DO I=1,sNx            DO I=1,sNx
# Line 1439  C     remove the fusion part for the res Line 1438  C     remove the fusion part for the res
1438          ENDDO          ENDDO
1439  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1440  C       end IT loop  C       end IT loop
1441          ENDDO          ENDDO
1442  #endif  #endif
1443  #ifdef SEAICE_DEBUG  #ifdef SEAICE_DEBUG
1444  c ToM<<< debug seaice_growth  c ToM<<< debug seaice_growth
# Line 1462  c ToM<<< debug seaice_growth Line 1461  c ToM<<< debug seaice_growth
1461          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1462       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1463  c ToM>>>  c ToM>>>
1464  #endif  #endif /* SEAICE_DEBUG */
1465    
1466  C compute ice thickness tendency due to ice-ocean interaction  C compute ice thickness tendency due to ice-ocean interaction
1467  C ===========================================================  C ===========================================================
# Line 1476  CADJ STORE r_QbyOCN = comlev1_bibj,key=i Line 1475  CADJ STORE r_QbyOCN = comlev1_bibj,key=i
1475          DO IT=1,nITD          DO IT=1,nITD
1476           DO J=1,sNy           DO J=1,sNy
1477            DO I=1,sNx            DO I=1,sNx
1478  C          ice growth/melt due to ocean heat r_QbyOCN (W/m^2) is  C          ice growth/melt due to ocean heat r_QbyOCN (W/m^2) is
1479  C          equally distributed under the ice and hence weighted by  C          equally distributed under the ice and hence weighted by
1480  C          fractional area of each thickness category  C          fractional area of each thickness category
1481             tmpscal1=MAX(r_QbyOCN(i,j)*areaFracFactor(I,J,IT),             tmpscal1=MAX(r_QbyOCN(i,j)*areaFracFactor(I,J,IT),
1482       &                               -HEFFITD(I,J,IT,bi,bj))       &                               -HEFFITD(I,J,IT,bi,bj))
1483             d_HEFFbyOCNonICE_ITD(I,J,IT)=tmpscal1             d_HEFFbyOCNonICE_ITD(I,J,IT)=tmpscal1
1484             d_HEFFbyOCNonICE(I,J) = d_HEFFbyOCNonICE(I,J) + tmpscal1             d_HEFFbyOCNonICE(I,J) = d_HEFFbyOCNonICE(I,J) + tmpscal1
# Line 1490  C          fractional area of each thick Line 1489  C          fractional area of each thick
1489          DO J=1,sNy          DO J=1,sNy
1490           DO I=1,sNx           DO I=1,sNx
1491            SItrHEFF(I,J,bi,bj,2) = HEFFpreTH(I,J)            SItrHEFF(I,J,bi,bj,2) = HEFFpreTH(I,J)
1492       &                          + d_HEFFbySublim(I,J)       &                          + d_HEFFbySublim(I,J)
1493       &                          + d_HEFFbyOCNonICE(I,J)       &                          + d_HEFFbyOCNonICE(I,J)
1494           ENDDO           ENDDO
1495          ENDDO          ENDDO
1496  #endif  #endif
# Line 1524  c ToM<<< debug seaice_growth Line 1523  c ToM<<< debug seaice_growth
1523          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1524       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1525  c ToM>>>  c ToM>>>
1526  #endif  #endif /* SEAICE_DEBUG */
1527    
1528  C compute snow melt tendency due to snow-atmosphere interaction  C compute snow melt tendency due to snow-atmosphere interaction
1529  C ==================================================================  C ==================================================================
# Line 1535  CADJ STORE r_QbyATM_cover = comlev1_bibj Line 1534  CADJ STORE r_QbyATM_cover = comlev1_bibj
1534  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
1535    
1536  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1537          DO IT=1,nITD          DO IT=1,nITD
1538           DO J=1,sNy           DO J=1,sNy
1539            DO I=1,sNx            DO I=1,sNx
1540  C     Convert to standard units (meters of ice) rather than to meters  C     Convert to standard units (meters of ice) rather than to meters
# Line 1550  Cgf no additional dependency through sno Line 1549  Cgf no additional dependency through sno
1549             d_HSNWbyATMonSNW_ITD(I,J,IT) = tmpscal2*ICE2SNOW             d_HSNWbyATMonSNW_ITD(I,J,IT) = tmpscal2*ICE2SNOW
1550             d_HSNWbyATMonSNW(I,J) = d_HSNWbyATMonSNW(I,J)             d_HSNWbyATMonSNW(I,J) = d_HSNWbyATMonSNW(I,J)
1551       &                           + tmpscal2*ICE2SNOW       &                           + tmpscal2*ICE2SNOW
1552             r_QbyATMmult_cover(I,J,IT)=r_QbyATMmult_cover(I,J,IT)             r_QbyATMmult_cover(I,J,IT)=r_QbyATMmult_cover(I,J,IT)
1553       &                           - tmpscal2       &                           - tmpscal2
1554            ENDDO            ENDDO
1555           ENDDO           ENDDO
1556          ENDDO          ENDDO
1557  #else /* SEAICE_ITD */  #else /* SEAICE_ITD */
1558          DO J=1,sNy          DO J=1,sNy
1559           DO I=1,sNx           DO I=1,sNx
# Line 1584  c ToM<<< debug seaice_growth Line 1583  c ToM<<< debug seaice_growth
1583          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1584       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1585  c ToM>>>  c ToM>>>
1586  #endif  #endif /* SEAICE_DEBUG */
1587    
1588  C compute ice thickness tendency due to the atmosphere  C compute ice thickness tendency due to the atmosphere
1589  C ====================================================  C ====================================================
# Line 1600  Cgf the v1.81=>v1.82 revision would chan Line 1599  Cgf the v1.81=>v1.82 revision would chan
1599  Cgf warming conditions, the lab_sea results were not changed.  Cgf warming conditions, the lab_sea results were not changed.
1600    
1601  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1602          DO IT=1,nITD          DO IT=1,nITD
1603           DO J=1,sNy           DO J=1,sNy
1604            DO I=1,sNx            DO I=1,sNx
1605             tmpscal1 = HEFFITDpreTH(I,J,IT)             tmpscal1 = HEFFITDpreTH(I,J,IT)
1606       &              + d_HEFFbySublim_ITD(I,J,IT)       &              + d_HEFFbySublim_ITD(I,J,IT)
1607       &              + d_HEFFbyOCNonICE_ITD(I,J,IT)       &              + d_HEFFbyOCNonICE_ITD(I,J,IT)
1608  #ifdef SEAICE_GROWTH_LEGACY  #ifdef SEAICE_GROWTH_LEGACY
# Line 1618  c         Limit ice growth by potential Line 1617  c         Limit ice growth by potential
1617             d_HEFFbyATMonOCN_cover_ITD(I,J,IT) = tmpscal2             d_HEFFbyATMonOCN_cover_ITD(I,J,IT) = tmpscal2
1618             d_HEFFbyATMonOCN_cover(I,J) = d_HEFFbyATMonOCN_cover(I,J)             d_HEFFbyATMonOCN_cover(I,J) = d_HEFFbyATMonOCN_cover(I,J)
1619       &                                 + tmpscal2       &                                 + tmpscal2
1620             d_HEFFbyATMonOCN_ITD(I,J,IT) = d_HEFFbyATMonOCN_ITD(I,J,IT)             d_HEFFbyATMonOCN_ITD(I,J,IT) = d_HEFFbyATMonOCN_ITD(I,J,IT)
1621       &                                 + tmpscal2       &                                 + tmpscal2
1622             d_HEFFbyATMonOCN(I,J)       = d_HEFFbyATMonOCN(I,J)             d_HEFFbyATMonOCN(I,J)       = d_HEFFbyATMonOCN(I,J)
1623       &                                 + tmpscal2       &                                 + tmpscal2
1624             r_QbyATMmult_cover(I,J,IT)  = r_QbyATMmult_cover(I,J,IT)             r_QbyATMmult_cover(I,J,IT)  = r_QbyATMmult_cover(I,J,IT)
1625       &                                 - tmpscal2       &                                 - tmpscal2
1626            ENDDO            ENDDO
1627           ENDDO           ENDDO
1628          ENDDO          ENDDO
1629  #ifdef ALLOW_SITRACER  #ifdef ALLOW_SITRACER
1630          DO J=1,sNy          DO J=1,sNy
1631           DO I=1,sNx           DO I=1,sNx
1632            SItrHEFF(I,J,bi,bj,3) = SItrHEFF(I,J,bi,bj,2)            SItrHEFF(I,J,bi,bj,3) = SItrHEFF(I,J,bi,bj,2)
1633       &                          + d_HEFFbyATMonOCN_cover(I,J)       &                          + d_HEFFbyATMonOCN_cover(I,J)
1634           ENDDO           ENDDO
1635          ENDDO          ENDDO
1636  #endif  #endif
1637  #else /* SEAICE_ITD */  #else /* SEAICE_ITD */
1638          DO J=1,sNy          DO J=1,sNy
# Line 1679  c ToM<<< debug seaice_growth Line 1678  c ToM<<< debug seaice_growth
1678          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1679       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1680  c ToM>>>  c ToM>>>
1681  #endif  #endif /* SEAICE_DEBUG */
1682    
1683  C add snow precipitation to HSNOW.  C add snow precipitation to HSNOW.
1684  C =================================================  C =================================================
# Line 1723  C           add precip to the fresh wate Line 1722  C           add precip to the fresh wate
1722           ENDDO           ENDDO
1723          ENDDO          ENDDO
1724  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1725          DO IT=1,nITD          DO IT=1,nITD
1726           DO J=1,sNy           DO J=1,sNy
1727            DO I=1,sNx            DO I=1,sNx
1728             d_HSNWbyRAIN_ITD(I,J,IT)             d_HSNWbyRAIN_ITD(I,J,IT)
1729       &     = d_HSNWbyRAIN(I,J)*areaFracFactor(I,J,IT)       &     = d_HSNWbyRAIN(I,J)*areaFracFactor(I,J,IT)
1730            ENDDO            ENDDO
1731           ENDDO           ENDDO
1732          ENDDO          ENDDO
1733  #else  #else
1734          DO J=1,sNy          DO J=1,sNy
1735           DO I=1,sNx           DO I=1,sNx
# Line 1756  c ToM<<< debug seaice_growth Line 1755  c ToM<<< debug seaice_growth
1755          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1756       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1757  c ToM>>>  c ToM>>>
1758  #endif  #endif /* SEAICE_DEBUG */
1759    
1760  C compute snow melt due to heat available from ocean.  C compute snow melt due to heat available from ocean.
1761  C =================================================================  C =================================================================
# Line 1773  CADJ STORE r_QbyOCN = comlev1_bibj,key=i Line 1772  CADJ STORE r_QbyOCN = comlev1_bibj,key=i
1772          DO IT=1,nITD          DO IT=1,nITD
1773           DO J=1,sNy           DO J=1,sNy
1774            DO I=1,sNx            DO I=1,sNx
1775             tmpscal4 = HSNWITDpreTH(I,J,IT)             tmpscal4 = HSNWITDpreTH(I,J,IT)
1776       &              + d_HSNWbySublim_ITD(I,J,IT)       &              + d_HSNWbySublim_ITD(I,J,IT)
1777       &              + d_HSNWbyATMonSNW_ITD(I,J,IT)       &              + d_HSNWbyATMonSNW_ITD(I,J,IT)
1778       &              + d_HSNWbyRAIN_ITD(I,J,IT)       &              + d_HSNWbyRAIN_ITD(I,J,IT)
1779             tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW*areaFracFactor(I,J,IT),             tmpscal1=MAX(r_QbyOCN(i,j)*ICE2SNOW*areaFracFactor(I,J,IT),
1780       &                  -tmpscal4)       &                  -tmpscal4)
1781             tmpscal2=MIN(tmpscal1,0. _d 0)             tmpscal2=MIN(tmpscal1,0. _d 0)
1782  #ifdef SEAICE_MODIFY_GROWTH_ADJ  #ifdef SEAICE_MODIFY_GROWTH_ADJ
# Line 1820  c ToM<<< debug seaice_growth Line 1819  c ToM<<< debug seaice_growth
1819          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1820       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1821  c ToM>>>  c ToM>>>
1822  #endif  #endif /* SEAICE_DEBUG */
1823    
1824  C gain of new ice over open water  C gain of new ice over open water
1825  C ===============================  C ===============================
# Line 1837  CADJ STORE a_QSWbyATM_open = comlev1_bib Line 1836  CADJ STORE a_QSWbyATM_open = comlev1_bib
1836  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1837  C         HEFF will be updated at the end of PART 3,  C         HEFF will be updated at the end of PART 3,
1838  C         hence sum of tendencies so far is needed  C         hence sum of tendencies so far is needed
1839            tmpscal4 = HEFFpreTH(I,J)            tmpscal4 = HEFFpreTH(I,J)
1840       &             + d_HEFFbySublim(I,J)       &             + d_HEFFbySublim(I,J)
1841       &             + d_HEFFbyOCNonICE(I,J)       &             + d_HEFFbyOCNonICE(I,J)
1842       &             + d_HEFFbyATMonOCN(I,J)       &             + d_HEFFbyATMonOCN(I,J)
1843  #else  #else
1844  C         HEFF is updated step by step throughout seaice_growth  C         HEFF is updated step by step throughout seaice_growth
1845            tmpscal4 = HEFF(I,J,bi,bj)            tmpscal4 = HEFF(I,J,bi,bj)
1846  #endif  #endif
1847  C           Initial ice growth is triggered by open water  C           Initial ice growth is triggered by open water
1848  C           heat flux overcoming potential melt by ocean  C           heat flux overcoming potential melt by ocean
# Line 1903  c ToM<<< debug seaice_growth Line 1902  c ToM<<< debug seaice_growth
1902          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1903       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1904  c ToM>>>  c ToM>>>
1905  #endif  #endif /* SEAICE_DEBUG */
1906    
1907  C convert snow to ice if submerged.  C convert snow to ice if submerged.
1908  C =================================  C =================================
# Line 1916  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi Line 1915  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi
1915  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
1916          IF ( SEAICEuseFlooding ) THEN          IF ( SEAICEuseFlooding ) THEN
1917  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1918           DO IT=1,nITD           DO IT=1,nITD
1919            DO J=1,sNy            DO J=1,sNy
1920             DO I=1,sNx             DO I=1,sNx
1921              tmpscal3 = HEFFITDpreTH(I,J,IT)              tmpscal3 = HEFFITDpreTH(I,J,IT)
1922       &               + d_HEFFbySublim_ITD(I,J,IT)       &               + d_HEFFbySublim_ITD(I,J,IT)
1923       &               + d_HEFFbyOCNonICE_ITD(I,J,IT)       &               + d_HEFFbyOCNonICE_ITD(I,J,IT)
1924       &               + d_HEFFbyATMonOCN_ITD(I,J,IT)       &               + d_HEFFbyATMonOCN_ITD(I,J,IT)
1925              tmpscal4 = HSNWITDpreTH(I,J,IT)              tmpscal4 = HSNWITDpreTH(I,J,IT)
1926       &               + d_HSNWbySublim_ITD(I,J,IT)       &               + d_HSNWbySublim_ITD(I,J,IT)
1927       &               + d_HSNWbyATMonSNW_ITD(I,J,IT)       &               + d_HSNWbyATMonSNW_ITD(I,J,IT)
1928       &               + d_HSNWbyRAIN_ITD(I,J,IT)       &               + d_HSNWbyRAIN_ITD(I,J,IT)
# Line 1933  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi Line 1932  CADJ STORE hsnow(:,:,bi,bj) = comlev1_bi
1932              tmpscal1 = MAX( 0. _d 0, tmpscal0 - tmpscal3)              tmpscal1 = MAX( 0. _d 0, tmpscal0 - tmpscal3)
1933              d_HEFFbyFLOODING_ITD(I,J,IT) = tmpscal1              d_HEFFbyFLOODING_ITD(I,J,IT) = tmpscal1
1934              d_HEFFbyFLOODING(I,J) = d_HEFFbyFLOODING(I,J)  + tmpscal1              d_HEFFbyFLOODING(I,J) = d_HEFFbyFLOODING(I,J)  + tmpscal1
1935             ENDDO             ENDDO
1936            ENDDO            ENDDO
1937           ENDDO           ENDDO
1938  #else  #else
1939           DO J=1,sNy           DO J=1,sNy
1940            DO I=1,sNx            DO I=1,sNx
# Line 1963  c ToM<<< debug seaice_growth Line 1962  c ToM<<< debug seaice_growth
1962          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
1963       &    SQUEEZE_RIGHT , myThid)       &    SQUEEZE_RIGHT , myThid)
1964  c ToM>>>  c ToM>>>
1965  #endif  #endif /* SEAICE_DEBUG */
1966  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
1967  C apply ice and snow thickness changes  C apply ice and snow thickness changes
1968  C =================================================================  C =================================================================
1969           DO IT=1,nITD           DO IT=1,nITD
1970            DO J=1,sNy            DO J=1,sNy
1971             DO I=1,sNx             DO I=1,sNx
1972              HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj)              HEFFITD(I,J,IT,bi,bj) = HEFFITD(I,J,IT,bi,bj)
1973       &                            + d_HEFFbySublim_ITD(I,J,IT)       &                            + d_HEFFbySublim_ITD(I,J,IT)
1974       &                            + d_HEFFbyOCNonICE_ITD(I,J,IT)       &                            + d_HEFFbyOCNonICE_ITD(I,J,IT)
1975       &                            + d_HEFFbyATMonOCN_ITD(I,J,IT)       &                            + d_HEFFbyATMonOCN_ITD(I,J,IT)
1976       &                            + d_HEFFbyFLOODING_ITD(I,J,IT)       &                            + d_HEFFbyFLOODING_ITD(I,J,IT)
1977              HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj)              HSNOWITD(I,J,IT,bi,bj) = HSNOWITD(I,J,IT,bi,bj)
1978       &                            + d_HSNWbySublim_ITD(I,J,IT)       &                            + d_HSNWbySublim_ITD(I,J,IT)
1979       &                            + d_HSNWbyATMonSNW_ITD(I,J,IT)       &                            + d_HSNWbyATMonSNW_ITD(I,J,IT)
1980       &                            + d_HSNWbyRAIN_ITD(I,J,IT)       &                            + d_HSNWbyRAIN_ITD(I,J,IT)
1981       &                            + d_HSNWbyOCNonSNW_ITD(I,J,IT)       &                            + d_HSNWbyOCNonSNW_ITD(I,J,IT)
1982       &                            - d_HEFFbyFLOODING_ITD(I,J,IT)       &                            - d_HEFFbyFLOODING_ITD(I,J,IT)
1983       &                            * ICE2SNOW       &                            * ICE2SNOW
1984             ENDDO             ENDDO
1985            ENDDO            ENDDO
1986           ENDDO           ENDDO
1987  #endif  #endif
1988  c ToM<<< debug seaice_growth  c ToM<<< debug seaice_growth
1989          WRITE(msgBuf,msgBufForm)          WRITE(msgBuf,msgBufForm)
# Line 2033  CADJ STORE AREA(:,:,bi,bj) = comlev1_bib Line 2032  CADJ STORE AREA(:,:,bi,bj) = comlev1_bib
2032    
2033  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
2034  C--     account for lateral ice growth and melt only in thinnest category  C--     account for lateral ice growth and melt only in thinnest category
2035  C--     use HEFF, ARE, HSNOW, etc. temporarily for 1st category  C--     use HEFF, ARE, HSNOW, etc. temporarily for 1st category
2036  C       (this way we can use same code for ITD and non-ITD case)  C       (this way we can use same code for ITD and non-ITD case)
2037          DO J=1,sNy          DO J=1,sNy
2038           DO I=1,sNx           DO I=1,sNx
# Line 2043  C       (this way we can use same code f Line 2042  C       (this way we can use same code f
2042            HEFFpreTH(I,J)=HEFFITDpreTH(I,J,1)            HEFFpreTH(I,J)=HEFFITDpreTH(I,J,1)
2043            AREApreTH(I,J)=AREAITDpreTH(I,J,1)            AREApreTH(I,J)=AREAITDpreTH(I,J,1)
2044            recip_heffActual(I,J)=recip_heffActualMult(I,J,1)            recip_heffActual(I,J)=recip_heffActualMult(I,J,1)
2045           ENDDO           ENDDO
2046          ENDDO          ENDDO
2047  C       all other categories only experience basal growth or melt,  C       all other categories only experience basal growth or melt,
2048  C       i.e. change sin AREA only occur when all ice in a category is melted  C       i.e. change sin AREA only occur when all ice in a category is melted
2049          IF (nITD .gt. 1) THEN          IF (nITD .gt. 1) THEN
2050           DO IT=2,nITD           DO IT=2,nITD
2051            DO J=1,sNy            DO J=1,sNy
2052             DO I=1,sNx             DO I=1,sNx
2053              IF (HEFFITD(I,J,IT,bi,bj).LE.ZERO) THEN              IF (HEFFITD(I,J,IT,bi,bj).LE.ZERO) THEN
2054               AREAITD(I,J,IT,bi,bj)=ZERO               AREAITD(I,J,IT,bi,bj)=ZERO
2055              ENDIF              ENDIF
2056             ENDDO             ENDDO
2057            ENDDO            ENDDO
2058           ENDDO           ENDDO
2059          ENDIF          ENDIF
2060  #endif  #endif
2061          DO J=1,sNy          DO J=1,sNy
2062           DO I=1,sNx           DO I=1,sNx
# Line 2143  C       transfer 1st category values bac Line 2142  C       transfer 1st category values bac
2142  Cgf 'bulk' linearization of area=f(HEFF)  Cgf 'bulk' linearization of area=f(HEFF)
2143          IF ( SEAICEadjMODE.GE.1 ) THEN          IF ( SEAICEadjMODE.GE.1 ) THEN
2144  #ifdef SEAICE_ITD  #ifdef SEAICE_ITD
2145           DO IT=1,nITD           DO IT=1,nITD
2146            DO J=1,sNy            DO J=1,sNy
2147             DO I=1,sNx             DO I=1,sNx
2148              AREAITD(I,J,IT,bi,bj) = AREAITDpreTH(I,J,IT) + 0.1 _d 0 *              AREAITD(I,J,IT,bi,bj) = AREAITDpreTH(I,J,IT) + 0.1 _d 0 *
# Line 2395  C compute total of "mult" fluxes for oce Line 2394  C compute total of "mult" fluxes for oce
2394           DO J=1,sNy           DO J=1,sNy
2395            DO I=1,sNx            DO I=1,sNx
2396  cToM if fluxes in W/m^2 then  cToM if fluxes in W/m^2 then
2397  c           a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)  c           a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2398  c     &      + a_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)  c     &      + a_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2399  c           r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)  c           r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2400  c     &      + r_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)  c     &      + r_QbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2401  c           a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)  c           a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2402  c     &      + a_QSWbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)  c     &      + a_QSWbyATMmult_cover(I,J,IT) * areaFracFactor(I,J,IT)
2403  c           r_FWbySublim(I,J)=r_FWbySublim(I,J)  c           r_FWbySublim(I,J)=r_FWbySublim(I,J)
2404  c     &      + r_FWbySublimMult(I,J,IT) * areaFracFactor(I,J,IT)  c     &      + r_FWbySublimMult(I,J,IT) * areaFracFactor(I,J,IT)
2405  cToM if fluxes in effective ice meters, i.e. ice volume per area, then  cToM if fluxes in effective ice meters, i.e. ice volume per area, then
2406             a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)             a_QbyATM_cover(I,J)=a_QbyATM_cover(I,J)
2407       &      + a_QbyATMmult_cover(I,J,IT)       &      + a_QbyATMmult_cover(I,J,IT)
2408             r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)             r_QbyATM_cover(I,J)=r_QbyATM_cover(I,J)
2409       &      + r_QbyATMmult_cover(I,J,IT)       &      + r_QbyATMmult_cover(I,J,IT)
2410             a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)             a_QSWbyATM_cover(I,J)=a_QSWbyATM_cover(I,J)
2411       &      + a_QSWbyATMmult_cover(I,J,IT)       &      + a_QSWbyATMmult_cover(I,J,IT)
2412             r_FWbySublim(I,J)=r_FWbySublim(I,J)             r_FWbySublim(I,J)=r_FWbySublim(I,J)
2413       &      + r_FWbySublimMult(I,J,IT)       &      + r_FWbySublimMult(I,J,IT)
2414            ENDDO            ENDDO
2415           ENDDO           ENDDO
# Line 2473  CADJ &                       key = iicek Line 2472  CADJ &                       key = iicek
2472  # endif /* ALLOW_AUTODIFF_TAMC */  # endif /* ALLOW_AUTODIFF_TAMC */
2473  cgf Unlike for evap and precip, the temperature of gained/lost  cgf Unlike for evap and precip, the temperature of gained/lost
2474  C ocean liquid water due to melt/freeze of solid water cannot be chosen  C ocean liquid water due to melt/freeze of solid water cannot be chosen
2475  C arbitrarily to be e.g. the ocean SST. Indeed the present seaice model  C arbitrarily to be e.g. the ocean SST. Indeed the present seaice model
2476  C implies a constant ice temperature of 0degC. If melt/freeze water is exchanged  C implies a constant ice temperature of 0degC. If melt/freeze water is exchanged
2477  C at a different temperature, it leads to a loss of conservation in the  C at a different temperature, it leads to a loss of conservation in the
2478  C ocean+ice system. While this is mostly a serious issue in the  C ocean+ice system. While this is mostly a serious issue in the
2479  C real fresh water + non linear free surface framework, a mismatch  C real fresh water + non linear free surface framework, a mismatch
2480  C between ice and ocean boundary condition can result in all cases.  C between ice and ocean boundary condition can result in all cases.
2481  C Below we therefore anticipate on external_forcing_surf.F  C Below we therefore anticipate on external_forcing_surf.F
2482  C to diagnoze and/or apply the correction to QNET.  C to diagnoze and/or apply the correction to QNET.
2483          DO J=1,sNy          DO J=1,sNy
2484           DO I=1,sNx           DO I=1,sNx
# Line 2533  CML according to wave-length) fluxes but Line 2532  CML according to wave-length) fluxes but
2532  CML since it does not contribute to heating the air.  CML since it does not contribute to heating the air.
2533  CML So this diagnostic is only good for heat budget calculations within  CML So this diagnostic is only good for heat budget calculations within
2534  CML the ice-ocean system.  CML the ice-ocean system.
2535             SIatmQnt(I,J,bi,bj) =             SIatmQnt(I,J,bi,bj) =
2536       &            maskC(I,J,kSurface,bi,bj)*convertHI2Q*(       &            maskC(I,J,kSurface,bi,bj)*convertHI2Q*(
2537  #ifndef SEAICE_GROWTH_LEGACY  #ifndef SEAICE_GROWTH_LEGACY
2538       &            a_QSWbyATM_cover(I,J) +       &            a_QSWbyATM_cover(I,J) +
2539  #endif /* SEAICE_GROWTH_LEGACY */  #endif /* SEAICE_GROWTH_LEGACY */
2540       &            a_QbyATM_cover(I,J) + a_QbyATM_open(I,J) )       &            a_QbyATM_cover(I,J) + a_QbyATM_open(I,J) )
2541  cgf 2) SItflux (analogous to tflux; includes advection by water  cgf 2) SItflux (analogous to tflux; includes advection by water
2542  C             exchanged between atmosphere and ocean+ice)  C             exchanged between atmosphere and ocean+ice)
2543  C solid water going to atm, in precip units  C solid water going to atm, in precip units
2544             tmpscal1 = rhoConstFresh*maskC(I,J,kSurface,bi,bj)             tmpscal1 = rhoConstFresh*maskC(I,J,kSurface,bi,bj)
# Line 2574  C linFS, rain/evap get a special treatme Line 2573  C linFS, rain/evap get a special treatme
2573             tmpscal2= ZERO             tmpscal2= ZERO
2574        ENDIF        ENDIF
2575             SItflux(I,J,bi,bj)=             SItflux(I,J,bi,bj)=
2576       &            SIatmQnt(I,J,bi,bj)-tmpscal1-tmpscal2           &            SIatmQnt(I,J,bi,bj)-tmpscal1-tmpscal2
2577            ENDDO            ENDDO
2578           ENDDO           ENDDO
2579    
# Line 2616  c and the flux leaving/entering the ocea Line 2615  c and the flux leaving/entering the ocea
2615       &     + a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm       &     + a_FWbySublim(I,J) * SEAICE_rhoIce * recip_deltaTtherm
2616    
2617           ENDDO           ENDDO
2618          ENDDO                  ENDDO
2619    
2620  #ifdef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION  #ifdef ALLOW_SSH_GLOBMEAN_COST_CONTRIBUTION
2621  C--  C--
# Line 2694  C ====================================== Line 2693  C ======================================
2693         IF ( balanceEmPmR ) THEN         IF ( balanceEmPmR ) THEN
2694          DO j=1,sNy          DO j=1,sNy
2695           DO i=1,sNx           DO i=1,sNx
2696            FWFsiTile(bi,bj) =            FWFsiTile(bi,bj) =
2697       &      FWFsiTile(bi,bj) + SIatmFW(i,j,bi,bj)       &      FWFsiTile(bi,bj) + SIatmFW(i,j,bi,bj)
2698       &      * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)       &      * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2699           ENDDO           ENDDO
2700          ENDDO          ENDDO
2701         ENDIF         ENDIF
2702  c to translate global mean FWF adjustements (see below) we may need :  c to translate global mean FWF adjustements (see below) we may need :
2703         FWF2HFsiTile(bi,bj) = 0. _d 0               FWF2HFsiTile(bi,bj) = 0. _d 0
2704         IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN         IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2705          DO j=1,sNy          DO j=1,sNy
2706           DO i=1,sNx           DO i=1,sNx
# Line 2715  c to translate global mean FWF adjusteme Line 2714  c to translate global mean FWF adjusteme
2714         IF ( balanceQnet ) THEN         IF ( balanceQnet ) THEN
2715          DO j=1,sNy          DO j=1,sNy
2716           DO i=1,sNx           DO i=1,sNx
2717            HFsiTile(bi,bj) =            HFsiTile(bi,bj) =
2718       &      HFsiTile(bi,bj) + SItflux(i,j,bi,bj)       &      HFsiTile(bi,bj) + SItflux(i,j,bi,bj)
2719       &      * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)       &      * rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
2720           ENDDO           ENDDO
# Line 2827  CADJ STORE FWF2HFsiTile = comlev1, key=i Line 2826  CADJ STORE FWF2HFsiTile = comlev1, key=i
2826  # endif /* ALLOW_AUTODIFF_TAMC */  # endif /* ALLOW_AUTODIFF_TAMC */
2827        FWFsiGlob=0. _d 0        FWFsiGlob=0. _d 0
2828        IF ( balanceEmPmR )        IF ( balanceEmPmR )
2829       &   CALL GLOBAL_SUM_TILE_RL( FWFsiTile, FWFsiGlob, myThid )               &   CALL GLOBAL_SUM_TILE_RL( FWFsiTile, FWFsiGlob, myThid )
2830        FWF2HFsiGlob=0. _d 0        FWF2HFsiGlob=0. _d 0
2831        IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN        IF ( balanceEmPmR.AND.(temp_EvPrRn.EQ.UNSET_RL) ) THEN
2832           CALL GLOBAL_SUM_TILE_RL(FWF2HFsiTile, FWF2HFsiGlob, myThid)           CALL GLOBAL_SUM_TILE_RL(FWF2HFsiTile, FWF2HFsiGlob, myThid)
# Line 2857  c 3) balancing adjustments Line 2856  c 3) balancing adjustments
2856           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
2857              empmr(i,j,bi,bj) = empmr(i,j,bi,bj) - tmpscal0              empmr(i,j,bi,bj) = empmr(i,j,bi,bj) - tmpscal0
2858              SIatmFW(i,j,bi,bj) = SIatmFW(i,j,bi,bj) - tmpscal0              SIatmFW(i,j,bi,bj) = SIatmFW(i,j,bi,bj) - tmpscal0
2859  c           adjust SItflux consistently        c           adjust SItflux consistently
2860              IF ( (temp_EvPrRn.NE.UNSET_RL).AND.              IF ( (temp_EvPrRn.NE.UNSET_RL).AND.
2861       &        useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN       &        useRealFreshWaterFlux.AND.(nonlinFreeSurf.NE.0) ) THEN
2862              tmpscal1=              tmpscal1=
# Line 2880  c           no qnet or tflux adjustement Line 2879  c           no qnet or tflux adjustement
2879        ENDDO        ENDDO
2880        IF ( balancePrintMean ) THEN        IF ( balancePrintMean ) THEN
2881         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
2882         WRITE(msgbuf,'(a,a,e24.17)') 'rm Global mean of ',         WRITE(msgBuf,'(a,a,e24.17)') 'rm Global mean of ',
2883       &      'SIatmFW = ', tmpscal0       &      'SIatmFW = ', tmpscal0
2884         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2885       &      SQUEEZE_RIGHT , myThid)       &      SQUEEZE_RIGHT , myThid)
# Line 2901  c           no qnet or tflux adjustement Line 2900  c           no qnet or tflux adjustement
2900        ENDDO        ENDDO
2901        IF ( balancePrintMean ) THEN        IF ( balancePrintMean ) THEN
2902         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
2903         WRITE(msgbuf,'(a,a,e24.17)') 'rm Global mean of ',         WRITE(msgBuf,'(a,a,e24.17)') 'rm Global mean of ',
2904       &      'SItflux = ', tmpscal2       &      'SItflux = ', tmpscal2
2905         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
2906       &      SQUEEZE_RIGHT , myThid)       &      SQUEEZE_RIGHT , myThid)
2907         _END_MASTER( myThid )         _END_MASTER( myThid )
2908        ENDIF        ENDIF
2909        ENDIF        ENDIF
2910  #endif /* */  #endif /* ALLOW_BALANCE_FLUXES */
2911    
2912  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
2913  c these diags need to be done outside of the bi,bj loop so that  c these diags need to be done outside of the bi,bj loop so that

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

  ViewVC Help
Powered by ViewVC 1.1.22