New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13998 for NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icectl.F90 – NEMO

Ignore:
Timestamp:
2020-12-02T14:55:21+01:00 (3 years ago)
Author:
techene
Message:

branch updated with trunk 13787

Location:
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3

    • Property svn:externals
      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@13292        sette 
         10^/utils/CI/sette@13559        sette 
  • NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/ICE/icectl.F90

    r13295 r13998  
    4343   PUBLIC   ice_prt 
    4444   PUBLIC   ice_prt3D 
     45   PUBLIC   ice_drift_wri 
     46   PUBLIC   ice_drift_init 
    4547 
    4648   ! thresold rates for conservation 
     
    4951   REAL(wp), PARAMETER ::   zchk_s   = 2.5e-6   ! g/m2/s  <=> 1e-6 m of ice per hour spuriously gained/lost (considering s=10g/kg) 
    5052   REAL(wp), PARAMETER ::   zchk_t   = 7.5e-2   ! W/m2    <=> 1e-6 m of ice per hour spuriously gained/lost (considering Lf=3e5J/kg) 
     53 
     54   ! for drift outputs 
     55   CHARACTER(LEN=50)   ::   clname="icedrift_diagnostics.ascii"   ! ascii filename 
     56   INTEGER             ::   numicedrift                           ! outfile unit 
     57   REAL(wp)            ::   rdiag_icemass, rdiag_icesalt, rdiag_iceheat  
     58   REAL(wp)            ::   rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat  
    5159    
    5260   !! * Substitutions 
     
    132140 
    133141         ! -- advection scheme is conservative? -- ! 
    134          zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 (only for Prather) 
    135          zetrp = glob_sum( 'icectl', ( diag_trp_ei        + diag_trp_es        ) * e1e2t ) ! must be close to 0 (only for Prather) 
     142         zvtrp = glob_sum( 'icectl', diag_adv_mass * e1e2t ) 
     143         zetrp = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 
    136144 
    137145         ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     
    156164               &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_amax 
    157165            ! check if advection scheme is conservative 
    158             !    only check for Prather because Ultimate-Macho uses corrective fluxes (wfx etc) 
    159             !    so the formulation for conservation is different (and not coded)  
    160             !    it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now 
    161             !IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    162             !   &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice 
     166            IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
     167               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 
     168            IF( ABS(zetrp) > zchk_t * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
     169               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zetrp * rdt_ice 
    163170         ENDIF 
    164171         ! 
     
    186193      ! water flux 
    187194      ! -- mass diag -- ! 
    188       zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) 
     195      zdiag_mass = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
     196         &                              + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) 
    189197 
    190198      ! -- salt diag -- ! 
    191       zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) 
     199      zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) 
    192200 
    193201      ! -- heat diag -- ! 
    194       ! clem: not the good formulation 
    195       !!zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr  & 
    196       !!   &                              ) * e1e2t ) 
     202      zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
     203      ! equivalent to this: 
     204      !!zdiag_heat = glob_sum( 'icectl', ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 
     205      !!   &                                          - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr & 
     206      !!   &                                          ) * e1e2t ) 
    197207 
    198208      ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     
    204214         IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
    205215            &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rDt_ice 
    206          !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
     216         IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 
     217            &                   WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
    207218      ENDIF 
    208219      ! 
     
    350361      !!                   ***  ROUTINE ice_ctl ***  
    351362      !!                  
    352       !! ** Purpose :   Alerts in case of model crash 
     363      !! ** Purpose :   control checks 
    353364      !!------------------------------------------------------------------- 
    354365      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    355       INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices 
    356       INTEGER  ::   inb_altests       ! number of alert tests (max 20) 
    357       INTEGER  ::   ialert_id         ! number of the current alert 
    358       REAL(wp) ::   ztmelts           ! ice layer melting point 
     366      INTEGER  ::   ja, ji, jj, jk, jl ! dummy loop indices 
     367      INTEGER  ::   ialert_id          ! number of the current alert 
     368      REAL(wp) ::   ztmelts            ! ice layer melting point 
    359369      CHARACTER (len=30), DIMENSION(20) ::   cl_alname   ! name of alert 
    360370      INTEGER           , DIMENSION(20) ::   inb_alp     ! number of alerts positive 
    361371      !!------------------------------------------------------------------- 
    362  
    363       inb_altests = 10 
    364       inb_alp(:)  =  0 
    365  
    366       ! Alert if incompatible volume and concentration 
    367       ialert_id = 2 ! reference number of this alert 
    368       cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert 
     372      inb_alp(:) = 0 
     373      ialert_id = 0 
     374       
     375      ! Alert if very high salinity 
     376      ialert_id = ialert_id + 1 ! reference number of this alert 
     377      cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 
    369378      DO jl = 1, jpl 
    370379         DO_2D( 1, 1, 1, 1 ) 
    371             IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN 
    372                WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    373                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     380            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     381               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
     382                  WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 
     383                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     384                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     385               ENDIF 
    374386            ENDIF 
    375387         END_2D 
    376388      END DO 
    377389 
    378       ! Alerte if very thick ice 
    379       ialert_id = 3 ! reference number of this alert 
    380       cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert 
    381       jl = jpl  
    382       DO_2D( 1, 1, 1, 1 ) 
    383          IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN 
    384             WRITE(numout,*) ' ALERTE 3 :   Very thick ice' 
    385             !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    386             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    387          ENDIF 
    388       END_2D 
    389  
    390       ! Alert if very fast ice 
    391       ialert_id = 4 ! reference number of this alert 
    392       cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert 
    393       DO_2D( 1, 1, 1, 1 ) 
    394          IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2.  .AND.  & 
    395             &  at_i(ji,jj) > 0._wp   ) THEN 
    396             WRITE(numout,*) ' ALERTE 4 :   Very fast ice' 
    397             !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
    398             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    399          ENDIF 
    400       END_2D 
    401  
    402       ! Alert on salt flux 
    403       ialert_id = 5 ! reference number of this alert 
    404       cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
    405       DO_2D( 1, 1, 1, 1 ) 
    406          IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth 
    407             WRITE(numout,*) ' ALERTE 5 :   High salt flux' 
    408             !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    409             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    410          ENDIF 
    411       END_2D 
    412  
    413       ! Alert if there is ice on continents 
    414       ialert_id = 6 ! reference number of this alert 
    415       cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert 
    416       DO_2D( 1, 1, 1, 1 ) 
    417          IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
    418             WRITE(numout,*) ' ALERTE 6 :   Ice on continents' 
    419             !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
    420             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    421          ENDIF 
    422       END_2D 
    423  
    424 ! 
    425 !     ! Alert if very fresh ice 
    426       ialert_id = 7 ! reference number of this alert 
    427       cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert 
     390      ! Alert if very low salinity 
     391      ialert_id = ialert_id + 1 ! reference number of this alert 
     392      cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 
    428393      DO jl = 1, jpl 
    429394         DO_2D( 1, 1, 1, 1 ) 
    430             IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    431                WRITE(numout,*) ' ALERTE 7 :   Very fresh ice' 
    432 !                 CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    433                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     395            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     396               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
     397                  WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 
     398                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     399                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     400               ENDIF 
    434401            ENDIF 
    435402         END_2D 
    436403      END DO 
    437 ! 
    438       ! Alert if qns very big 
    439       ialert_id = 8 ! reference number of this alert 
    440       cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
    441       DO_2D( 1, 1, 1, 1 ) 
    442          IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
    443             ! 
    444             WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
    445             !CALL ice_prt( kt, ji, jj, 2, '   ') 
    446             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    447             ! 
    448          ENDIF 
    449       END_2D 
    450       !+++++ 
    451  
    452 !     ! Alert if too old ice 
    453       ialert_id = 9 ! reference number of this alert 
    454       cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert 
    455       DO jl = 1, jpl 
    456          DO_2D( 1, 1, 1, 1 ) 
    457             IF ( ( ( ABS( o_i(ji,jj,jl) ) > rDt_ice ) .OR. & 
    458                    ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
    459                           ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    460                WRITE(numout,*) ' ALERTE 9 :   Wrong ice age' 
    461                !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    462                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    463             ENDIF 
    464          END_2D 
    465       END DO 
    466    
    467       ! Alert if very warm ice 
    468       ialert_id = 10 ! reference number of this alert 
    469       cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert 
    470       inb_alp(ialert_id) = 0 
     404 
     405      ! Alert if very cold ice 
     406      ialert_id = ialert_id + 1 ! reference number of this alert 
     407      cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 
    471408      DO jl = 1, jpl 
    472409         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    473410            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    474             IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   & 
    475                &                            .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
    476                WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
     411            IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     412               WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 
     413               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
    477414              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    478415            ENDIF 
    479416         END_3D 
    480417      END DO 
     418   
     419      ! Alert if very warm ice 
     420      ialert_id = ialert_id + 1 ! reference number of this alert 
     421      cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 
     422      DO jl = 1, jpl 
     423         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     424            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
     425            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     426               WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 
     427               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
     428              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     429            ENDIF 
     430         END_3D 
     431      END DO 
     432       
     433      ! Alerte if very thick ice 
     434      ialert_id = ialert_id + 1 ! reference number of this alert 
     435      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
     436      jl = jpl  
     437      DO_2D( 1, 1, 1, 1 ) 
     438         IF( h_i(ji,jj,jl) > 50._wp ) THEN 
     439            WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
     440            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     441            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     442         ENDIF 
     443      END_2D 
     444 
     445      ! Alerte if very thin ice 
     446      ialert_id = ialert_id + 1 ! reference number of this alert 
     447      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
     448      jl = 1  
     449      DO_2D( 1, 1, 1, 1 ) 
     450         IF( h_i(ji,jj,jl) < rn_himin ) THEN 
     451            WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
     452            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     453            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     454         ENDIF 
     455      END_2D 
     456 
     457      ! Alert if very fast ice 
     458      ialert_id = ialert_id + 1 ! reference number of this alert 
     459      cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 
     460      DO_2D( 1, 1, 1, 1 ) 
     461         IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
     462            WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 
     463            WRITE(numout,*) ' at i,j = ',ji,jj 
     464            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     465         ENDIF 
     466      END_2D 
     467 
     468      ! Alert if there is ice on continents 
     469      ialert_id = ialert_id + 1 ! reference number of this alert 
     470      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
     471      DO_2D( 1, 1, 1, 1 ) 
     472         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
     473            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
     474            WRITE(numout,*) ' at i,j = ',ji,jj 
     475            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     476         ENDIF 
     477      END_2D 
     478 
     479      ! Alert if incompatible ice concentration and volume 
     480      ialert_id = ialert_id + 1 ! reference number of this alert 
     481      cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 
     482      DO_2D( 1, 1, 1, 1 ) 
     483         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
     484            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  
     485            WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 
     486            WRITE(numout,*) ' at i,j = ',ji,jj 
     487            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     488         ENDIF 
     489      END_2D 
    481490 
    482491      ! sum of the alerts on all processors 
    483492      IF( lk_mpp ) THEN 
    484          DO ialert_id = 1, inb_altests 
    485             CALL mpp_sum('icectl', inb_alp(ialert_id)) 
     493         DO ja = 1, ialert_id 
     494            CALL mpp_sum('icectl', inb_alp(ja)) 
    486495         END DO 
    487496      ENDIF 
     
    489498      ! print alerts 
    490499      IF( lwp ) THEN 
    491          ialert_id = 1                                 ! reference number of this alert 
    492          cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert 
    493500         WRITE(numout,*) ' time step ',kt 
    494501         WRITE(numout,*) ' All alerts at the end of ice model ' 
    495          DO ialert_id = 1, inb_altests 
    496             WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 
     502         DO ja = 1, ialert_id 
     503            WRITE(numout,*) ja, cl_alname(ja)//' : ', inb_alp(ja), ' times ! ' 
    497504         END DO 
    498505      ENDIF 
     
    543550               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    544551               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    545                WRITE(numout,*) 
    546552               WRITE(numout,*) ' - Cell values ' 
    547553               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
     
    552558               DO jl = 1, jpl 
    553559                  WRITE(numout,*) ' - Category (', jl,')' 
     560                  WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    554561                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl) 
    555562                  WRITE(numout,*) ' h_i           : ', h_i(ji,jj,jl) 
     
    588595               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    589596               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    590                WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)   
    591597               WRITE(numout,*) 
    592598                
     
    605611                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    606612                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)    
    607                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl) 
    608613               END DO !jl 
    609614                
     
    713718         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ') 
    714719         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ') 
    715          CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ') 
    716720         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ') 
    717721         CALL prt_ctl(tab2d_1=sv_i       (:,:,jl)        , clinfo1= ' sv_i        : ') 
     
    721725            CALL prt_ctl_info(' - Layer : ', ivar=jk) 
    722726            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ') 
     727            CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' e_i       : ') 
    723728         END DO 
    724729      END DO 
     
    731736       
    732737   END SUBROUTINE ice_prt3D 
     738 
     739 
     740   SUBROUTINE ice_drift_wri( kt ) 
     741      !!------------------------------------------------------------------- 
     742      !!                     ***  ROUTINE ice_drift_wri *** 
     743      !! 
     744      !! ** Purpose : conservation of mass, salt and heat 
     745      !!              write the drift in a ascii file at each time step 
     746      !!              and the total run drifts 
     747      !!------------------------------------------------------------------- 
     748      INTEGER, INTENT(in) ::   kt   ! ice time-step index 
     749      ! 
     750      INTEGER  ::   ji, jj 
     751      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 
     752      REAL(wp), DIMENSION(jpi,jpj) ::   zdiag_mass2D, zdiag_salt2D, zdiag_heat2D 
     753      !!------------------------------------------------------------------- 
     754      ! 
     755      IF( kt == nit000 .AND. lwp ) THEN 
     756         WRITE(numout,*) 
     757         WRITE(numout,*) 'ice_drift_wri: sea-ice drifts' 
     758         WRITE(numout,*) '~~~~~~~~~~~~~' 
     759      ENDIF 
     760      ! 
     761      ! 2D budgets (must be close to 0) 
     762      IF( iom_use('icedrift_mass') .OR. iom_use('icedrift_salt') .OR. iom_use('icedrift_heat') ) THEN 
     763         DO_2D( 1, 1, 1, 1 ) 
     764            zdiag_mass2D(ji,jj) =   wfx_ice(ji,jj)   + wfx_snw(ji,jj)   + wfx_spr(ji,jj) + wfx_sub(ji,jj) & 
     765               &                  + diag_vice(ji,jj) + diag_vsnw(ji,jj) - diag_adv_mass(ji,jj) 
     766            zdiag_salt2D(ji,jj) = sfx(ji,jj) + diag_sice(ji,jj) - diag_adv_salt(ji,jj) 
     767            zdiag_heat2D(ji,jj) = qt_oce_ai(ji,jj) - qt_atm_oi(ji,jj) + diag_heat(ji,jj) - diag_adv_heat(ji,jj) 
     768         END_2D 
     769         ! 
     770         ! write outputs 
     771         CALL iom_put( 'icedrift_mass', zdiag_mass2D ) 
     772         CALL iom_put( 'icedrift_salt', zdiag_salt2D ) 
     773         CALL iom_put( 'icedrift_heat', zdiag_heat2D ) 
     774      ENDIF 
     775 
     776      ! -- mass diag -- ! 
     777      zdiag_mass     = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
     778         &                                  + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rdt_ice 
     779      zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rDt_ice 
     780 
     781      ! -- salt diag -- ! 
     782      zdiag_salt     = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rdt_ice * 1.e-3 
     783      zdiag_adv_salt = glob_sum( 'icectl', diag_adv_salt * e1e2t ) * rDt_ice * 1.e-3 
     784 
     785      ! -- heat diag -- ! 
     786      zdiag_heat     = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
     787      zdiag_adv_heat = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 
     788 
     789      !                    ! write out to file 
     790      IF( lwp ) THEN 
     791         ! check global drift (must be close to 0) 
     792         WRITE(numicedrift,FMT='(2x,i6,3x,a19,4x,f25.5)') kt, 'mass drift     [kg]', zdiag_mass 
     793         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift     [kg]', zdiag_salt 
     794         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift     [W] ', zdiag_heat 
     795         ! check drift from advection scheme (can be /=0 with bdy but not sure why) 
     796         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'mass drift adv [kg]', zdiag_adv_mass 
     797         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift adv [kg]', zdiag_adv_salt 
     798         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift adv [W] ', zdiag_adv_heat 
     799      ENDIF 
     800      !                    ! drifts 
     801      rdiag_icemass = rdiag_icemass + zdiag_mass 
     802      rdiag_icesalt = rdiag_icesalt + zdiag_salt 
     803      rdiag_iceheat = rdiag_iceheat + zdiag_heat 
     804      rdiag_adv_icemass = rdiag_adv_icemass + zdiag_adv_mass 
     805      rdiag_adv_icesalt = rdiag_adv_icesalt + zdiag_adv_salt 
     806      rdiag_adv_iceheat = rdiag_adv_iceheat + zdiag_adv_heat 
     807      ! 
     808      !                    ! output drifts and close ascii file 
     809      IF( kt == nitend - nn_fsbc + 1 .AND. lwp ) THEN 
     810         ! to ascii file 
     811         WRITE(numicedrift,*) '******************************************' 
     812         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run mass drift     [kg]', rdiag_icemass 
     813         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run mass drift adv [kg]', rdiag_adv_icemass 
     814         WRITE(numicedrift,*) '******************************************' 
     815         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run salt drift     [kg]', rdiag_icesalt 
     816         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run salt drift adv [kg]', rdiag_adv_icesalt 
     817         WRITE(numicedrift,*) '******************************************' 
     818         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run heat drift     [W] ', rdiag_iceheat 
     819         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run heat drift adv [W] ', rdiag_adv_iceheat 
     820         CLOSE( numicedrift ) 
     821         ! 
     822         ! to ocean output 
     823         WRITE(numout,*) 
     824         WRITE(numout,*) 'ice_drift_wri: ice drifts information for the run ' 
     825         WRITE(numout,*) '~~~~~~~~~~~~~' 
     826         ! check global drift (must be close to 0) 
     827         WRITE(numout,*) '   sea-ice mass drift     [kg] = ', rdiag_icemass 
     828         WRITE(numout,*) '   sea-ice salt drift     [kg] = ', rdiag_icesalt 
     829         WRITE(numout,*) '   sea-ice heat drift     [W]  = ', rdiag_iceheat 
     830         ! check drift from advection scheme (can be /=0 with bdy but not sure why) 
     831         WRITE(numout,*) '   sea-ice mass drift adv [kg] = ', rdiag_adv_icemass 
     832         WRITE(numout,*) '   sea-ice salt drift adv [kg] = ', rdiag_adv_icesalt 
     833         WRITE(numout,*) '   sea-ice heat drift adv [W]  = ', rdiag_adv_iceheat 
     834      ENDIF 
     835      ! 
     836   END SUBROUTINE ice_drift_wri 
     837 
     838   SUBROUTINE ice_drift_init 
     839      !!---------------------------------------------------------------------- 
     840      !!                  ***  ROUTINE ice_drift_init  *** 
     841      !!                    
     842      !! ** Purpose :   create output file, initialise arrays 
     843      !!---------------------------------------------------------------------- 
     844      ! 
     845      IF( .NOT.ln_icediachk ) RETURN ! exit 
     846      ! 
     847      IF(lwp) THEN 
     848         WRITE(numout,*) 
     849         WRITE(numout,*) 'ice_drift_init: Output ice drifts to ',TRIM(clname), ' file' 
     850         WRITE(numout,*) '~~~~~~~~~~~~~' 
     851         WRITE(numout,*) 
     852         ! 
     853         ! create output ascii file 
     854         CALL ctl_opn( numicedrift, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 
     855         WRITE(numicedrift,*) 'Timestep  Drifts' 
     856         WRITE(numicedrift,*) '******************************************' 
     857      ENDIF 
     858      ! 
     859      rdiag_icemass = 0._wp 
     860      rdiag_icesalt = 0._wp 
     861      rdiag_iceheat = 0._wp 
     862      rdiag_adv_icemass = 0._wp 
     863      rdiag_adv_icesalt = 0._wp 
     864      rdiag_adv_iceheat = 0._wp 
     865      ! 
     866   END SUBROUTINE ice_drift_init 
    733867       
    734868#else 
Note: See TracChangeset for help on using the changeset viewer.