/[MITgcm]/MITgcm/pkg/seaice/seaice_solve4temp.F
ViewVC logotype

Diff of /MITgcm/pkg/seaice/seaice_solve4temp.F

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

revision 1.15 by ifenty, Sun Jun 19 23:01:54 2011 UTC revision 1.16 by ifenty, Wed Jun 29 21:39:06 2011 UTC
# Line 8  C     !ROUTINE: SEAICE_SOLVE4TEMP Line 8  C     !ROUTINE: SEAICE_SOLVE4TEMP
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE SEAICE_SOLVE4TEMP(        SUBROUTINE SEAICE_SOLVE4TEMP(
10       I   UG, HICE_ACTUAL, HSNOW_ACTUAL,       I   UG, HICE_ACTUAL, HSNOW_ACTUAL,
11    #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
12         I   F_lh_max,
13    #endif
14       U   TSURF,       U   TSURF,
15       O   F_ia, IcePenetSWFlux,       O   F_ia, IcePenetSWFlux,
16       O   FWsublim,       O   FWsublim,
# Line 64  C                 sublimation (kg/m^2/s) Line 67  C                 sublimation (kg/m^2/s)
67        _RL UG             (1:sNx,1:sNy)        _RL UG             (1:sNx,1:sNy)
68        _RL HICE_ACTUAL    (1:sNx,1:sNy)        _RL HICE_ACTUAL    (1:sNx,1:sNy)
69        _RL HSNOW_ACTUAL   (1:sNx,1:sNy)        _RL HSNOW_ACTUAL   (1:sNx,1:sNy)
70    #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
71          _RL F_lh_max       (1:sNx,1:sNy)
72    #endif
73        _RL TSURF      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL TSURF      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
74  c     _RL F_io_net       (1:sNx,1:sNy)  c     _RL F_io_net       (1:sNx,1:sNy)
75  c     _RL F_ia_net       (1:sNx,1:sNy)  c     _RL F_ia_net       (1:sNx,1:sNy)
# Line 375  C     snow/ice system. Line 381  C     snow/ice system.
381  #endif /* SEAICE_SOLVE4TEMP_LEGACY */  #endif /* SEAICE_SOLVE4TEMP_LEGACY */
382    
383  #ifdef SEAICE_DEBUG  #ifdef SEAICE_DEBUG
384           IF ( (I .EQ. SEAICE_debugPointX)   .and.           IF ( (I .EQ. SEAICE_debugPointI)   .and.
385       &        (J .EQ. SEAICE_debugPointY) ) THEN       &        (J .EQ. SEAICE_debugPointJ) ) THEN
386    
387            print '(A,i6)','-----------------------------------'            print '(A,i6)','-----------------------------------'
388            print '(A,i6)','ibi merged initialization ', myIter            print '(A,i6)','ibi merged initialization ', myIter
# Line 458  C     The following form does the same, Line 464  C     The following form does the same,
464  c     d(qh)/d(TICE)  c     d(qh)/d(TICE)
465            dqhice_dTice = cc1*cc3t/((cc2-cc3t*Ppascals)**2 *t2)            dqhice_dTice = cc1*cc3t/((cc2-cc3t*Ppascals)**2 *t2)
466    
467    #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
468    c     if the latent heat flux implied by tsurfLoc exceeds
469    c     F_lh_max, cap F_lh and decouple the flux magnitude from TICE
470              if (F_lh(I,J) .GT. F_lh_max(I,J)) THEN
471                 F_lh(I,J)  = F_lh_max(I,J)
472                 dqhice_dTice = ZERO
473              endif
474    #endif
475    
476    
477  c     d(F_ia)/d(TICE)  c     d(F_ia)/d(TICE)
478            dFiDTs1 = 4.0 _d 0 * D3*t3 + effConduct(I,J) + D1*UG(I,J)            dFiDTs1 = 4.0 _d 0 * D3*t3 + effConduct(I,J) + D1*UG(I,J)
479       &         + D1I*UG(I,J)*dqhice_dTice       &         + D1I*UG(I,J)*dqhice_dTice
# Line 472  c     d(F_ia)/d(TICE) Line 488  c     d(F_ia)/d(TICE)
488  #endif /* SEAICE_SOLVE4TEMP_LEGACY */  #endif /* SEAICE_SOLVE4TEMP_LEGACY */
489    
490  #ifdef SEAICE_DEBUG  #ifdef SEAICE_DEBUG
491            IF ( (I .EQ. SEAICE_debugPointX)   .and.            IF ( (I .EQ. SEAICE_debugPointI)   .and.
492       &         (J .EQ. SEAICE_debugPointY) ) THEN       &         (J .EQ. SEAICE_debugPointJ) ) THEN
493             print '(A,i6,4(1x,D24.15))',             print '(A,i6,4(1x,D24.15))',
494       &          'ice-iter qhICE,       ', ITER,qhIce(I,J)       &          'ice-iter qhICE,       ', ITER,qhIce(I,J)
495    
# Line 519  C                 realistic values. Line 535  C                 realistic values.
535  #endif /* SEAICE_SOLVE4TEMP_LEGACY */  #endif /* SEAICE_SOLVE4TEMP_LEGACY */
536    
537  #ifdef SEAICE_DEBUG  #ifdef SEAICE_DEBUG
538            IF ( (I .EQ. SEAICE_debugPointX)   .and.            IF ( (I .EQ. SEAICE_debugPointI)   .and.
539       &         (J .EQ. SEAICE_debugPointY) ) THEN       &         (J .EQ. SEAICE_debugPointJ) ) THEN
540    
541             print '(A,i6,4(1x,D24.15))',             print '(A,i6,4(1x,D24.15))',
542       &          'ice-iter tsurfLc,|dif|', ITER,       &          'ice-iter tsurfLc,|dif|', ITER,
# Line 576  C              over ice specific humidit Line 592  C              over ice specific humidit
592           qhice(I,J) = bb1*mm_pi/(Ppascals- (1.0 _d 0 - bb1) * mm_pi)           qhice(I,J) = bb1*mm_pi/(Ppascals- (1.0 _d 0 - bb1) * mm_pi)
593    
594           F_lh(I,J) = D1I * UG(I,J)*(qhice(I,J)-AQH(I,J,bi,bj))           F_lh(I,J) = D1I * UG(I,J)*(qhice(I,J)-AQH(I,J,bi,bj))
595    
596    #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
597              if (F_lh(I,J) .GT. F_lh_max(I,J)) THEN
598                 F_lh(I,J)  = F_lh_max(I,J)
599              endif
600    #endif
601    
602           F_c(I,J)  = -effConduct(I,J) * (TB(I,J) - t1)           F_c(I,J)  = -effConduct(I,J) * (TB(I,J) - t1)
603           F_lwu(I,J)   = t4 * D3           F_lwu(I,J)   = t4 * D3
604           F_sens(I,J)  = D1 * UG(I,J) * (t1 - atempLoc(I,J))           F_sens(I,J)  = D1 * UG(I,J) * (t1 - atempLoc(I,J))
# Line 619  C     is also positive upward (atmospher Line 642  C     is also positive upward (atmospher
642           FWsublim(I,J) = F_lh(I,J)/lhSublim           FWsublim(I,J) = F_lh(I,J)/lhSublim
643    
644  #ifdef SEAICE_DEBUG  #ifdef SEAICE_DEBUG
645           IF ( (I .EQ. SEAICE_debugPointX)   .and.           IF ( (I .EQ. SEAICE_debugPointI)   .and.
646       &        (J .EQ. SEAICE_debugPointY) ) THEN       &        (J .EQ. SEAICE_debugPointJ) ) THEN
647    
648            print '(A)','----------------------------------------'            print '(A)','----------------------------------------'
649            print '(A,i6)','ibi complete ', myIter            print '(A,i6)','ibi complete ', myIter
# Line 640  C     is also positive upward (atmospher Line 663  C     is also positive upward (atmospher
663       &         'ibi qh(ATM ICE)            ',       &         'ibi qh(ATM ICE)            ',
664       &         AQH(I,J,bi,bj),qhice(I,J)       &         AQH(I,J,bi,bj),qhice(I,J)
665    
666  c         print '(A,4(1x,D24.15))',  #ifndef SEAICE_SOLVE4TEMP_LEGACY
667  c     &        'ibi F(lwd,swi,lwu)         ',           print '(A,4(1x,D24.15))',
668  c     &        F_lwd(I,J), F_swi(I,J), F_lwu(I,J)       &         'ibi F(lwd,swi,lwu)         ',
669         &         F_lwd(I,J), F_swi(I,J), F_lwu(I,J)
670  c         print '(A,4(1x,D24.15))',  
671  c     &        'ibi F(c,lh,sens)           ',           print '(A,4(1x,D24.15))',
672  c     &        F_c(I,J), F_lh(I,J), F_sens(I,J)       &         'ibi F(c,lh,sens)           ',
673         &         F_c(I,J), F_lh(I,J), F_sens(I,J)
674    
675    #ifdef SEAICE_ADD_SUBLIMATION_TO_FWBUDGET
676             IF (F_lh_max(I,J) .GT. ZERO) THEN
677                 print '(A,4(1x,D24.15))',
678         &         'ibi F_lh_max,  F_lh/lhmax) ',
679         &         F_lh_max(I,J), F_lh(I,J)/ F_lh_max(I,J)
680             ELSE
681                 print '(A,4(1x,D24.15))',
682         &         'ibi F_lh_max = ZERO! '
683             ENDIF
684    
685             print '(A,4(1x,D24.15))',
686         &         'ibi FWsub, FWsubm*dT/rhoI  ',
687         &          FWsublim(I,J),
688         &          FWsublim(I,J)*SEAICE_deltaTtherm/SEAICE_rhoICE
689    #endif
690    #endif
691    
692            print '(A,4(1x,D24.15))',            print '(A,4(1x,D24.15))',
693       &         'ibi F_ia, F_ia_net, F_c    ',       &         'ibi F_ia, F_ia_net, F_c    ',
# Line 669  c     &        F_c(I,J), F_lh(I,J), F_se Line 710  c     &        F_c(I,J), F_lh(I,J), F_se
710         ENDDO                    !/* i */         ENDDO                    !/* i */
711        ENDDO                     !/* j */        ENDDO                     !/* j */
712    
713        RETURN        RETURN
714        END        END
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22