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 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r4624 r5965  
    99   !!---------------------------------------------------------------------- 
    1010   !!   lim_wri      : write of the diagnostics variables in ouput file  
    11    !!   lim_wri_init : initialization and namelist read 
    1211   !!   lim_wri_state : write for initial state or/and abandon 
    1312   !!---------------------------------------------------------------------- 
     
    2524   USE lib_mpp         ! MPP library 
    2625   USE wrk_nemo        ! work arrays 
    27    USE par_ice 
    2826   USE iom 
    2927   USE timing          ! Timing 
     
    3634   PUBLIC lim_wri_state  ! called by dia_wri_state  
    3735 
    38    INTEGER, PARAMETER ::   jpnoumax = 43   !: maximum number of variable for ice output 
    39     
    40    INTEGER  ::   noumef             ! number of fields 
    41    INTEGER  ::   noumefa            ! number of additional fields 
    42    INTEGER  ::   add_diag_swi       ! additional diagnostics 
    43    INTEGER  ::   nz                                         ! dimension for the itd field 
    44  
    45    REAL(wp) , DIMENSION(jpnoumax) ::   cmulti         ! multiplicative constant 
    46    REAL(wp) , DIMENSION(jpnoumax) ::   cadd           ! additive constant 
    47    REAL(wp) , DIMENSION(jpnoumax) ::   cmultia        ! multiplicative constant 
    48    REAL(wp) , DIMENSION(jpnoumax) ::   cadda          ! additive constant 
    49    CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn, titna   ! title of the field 
    50    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam , nama    ! name of the field 
    51    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni , unia    ! unit of the field 
    52    INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 ) 
    53  
    54    REAL(wp)  ::   epsi06 = 1.e-6_wp 
    55    REAL(wp)  ::   zzero  = 0._wp 
    56    REAL(wp)  ::   zone   = 1._wp       
    5736   !!---------------------------------------------------------------------- 
    5837   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     
    7857      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere 
    7958      ! 
    80       INTEGER ::  ji, jj, jk, jl, jf, ipl ! dummy loop indices 
    81       INTEGER ::  ierr 
    82       REAL(wp),DIMENSION(1) ::   zdept 
    83       REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb, zindc 
    84       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa 
    85       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield 
    86       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmaskitd, zoi, zei 
    87  
    88       CHARACTER(len = 60) ::   clhstnam, clop, clhstnama 
    89  
    90       INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid 
    91       INTEGER , SAVE ::   nicea, nhorida, ndimitd 
    92       INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndex51 
    93       INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndexitd 
     59      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices 
     60      REAL(wp) ::  z1_365 
     61      REAL(wp) ::  ztmp 
     62      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei, zt_i, zt_s 
     63      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace 
    9464      !!------------------------------------------------------------------- 
    9565 
    9666      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    9767 
    98       CALL wrk_alloc( jpi, jpj, zfield ) 
    99       CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    100       CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
    101  
    102       ipl = jpl 
    103  
    104       IF( numit == nstart ) THEN  
    105  
    106          ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr ) 
    107          IF( lk_mpp    )   CALL mpp_sum ( ierr ) 
    108          IF( ierr /= 0 ) THEN 
    109             CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' )   ;   RETURN 
    110          ENDIF 
    111  
    112          CALL lim_wri_init  
    113  
    114          IF(lwp) WRITE(numout,*) ' lim_wri, first time step ' 
    115          IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    116  
    117          !-------------------- 
    118          !  1) Initialization 
    119          !-------------------- 
    120  
    121          !------------- 
    122          ! Normal file 
    123          !------------- 
    124          niter    = ( nit000 - 1 ) / nn_fsbc 
    125          CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 
    126          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    127 !clem 
    128 !         zsto     = rdt_ice 
    129 !         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!) 
    130 !         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time) 
    131 !         ENDIF 
    132 !         zout     = nwrite * rdt_ice / nn_fsbc 
    133 !         zdept(1) = 0. 
    134 ! 
    135 !         CALL dia_nam ( clhstnam, nwrite, 'icemod_old' ) 
    136 !         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   & 
    137 !            &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 
    138 !         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 
    139 !         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    140 ! 
    141 !         DO jf = 1 , noumef 
    142 !            IF(lwp) WRITE(numout,*) 'jf', jf 
    143 !            IF ( nc(jf) == 1 ) THEN 
    144 !               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 
    145 !                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    146 !               IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout' 
    147 !               IF(lwp) WRITE(numout,*)  nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout  
    148 !            ENDIF 
    149 !         END DO 
    150 ! 
    151 !         CALL histend(nice, snc4set) 
    152 !clem 
    153          ! 
    154          !----------------- 
    155          ! ITD file output 
    156          !----------------- 
    157          zsto     = rdt_ice 
    158          clop     = "ave(x)" 
    159          zout     = nwrite * rdt_ice / nn_fsbc 
    160          zdept(1) = 0. 
    161  
    162          CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 
    163          CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         & 
    164             1, jpi, 1, jpj,            & ! zoom 
    165             niter, zjulian, rdt_ice,   & ! time 
    166             nhorida,                   & ! ? linked with horizontal ... 
    167             nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file  
    168          CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 
     68      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
     69      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi ) 
     70 
     71      !----------------------------- 
     72      ! Mean category values 
     73      !----------------------------- 
     74      z1_365 = 1._wp / 365._wp 
     75 
     76      CALL lim_var_icetm      ! mean sea ice temperature 
     77 
     78      CALL lim_var_bv         ! brine volume 
     79 
     80      DO jj = 1, jpj          ! presence indicator of ice 
     81         DO ji = 1, jpi 
     82            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 
     83         END DO 
     84      END DO 
     85      ! 
     86      ! 
     87      !                                              
     88      IF ( iom_use( "icethic_cea" ) ) THEN                       ! mean ice thickness 
     89         DO jj = 1, jpj  
     90            DO ji = 1, jpi 
     91               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
     92            END DO 
     93         END DO 
     94         CALL iom_put( "icethic_cea"  , z2d              ) 
     95      ENDIF 
     96 
     97      IF ( iom_use( "snowthic_cea" ) ) THEN                      ! snow thickness = mean snow thickness over the cell  
     98         DO jj = 1, jpj                                             
     99            DO ji = 1, jpi 
     100               z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) 
     101            END DO 
     102         END DO 
     103         CALL iom_put( "snowthic_cea" , z2d              )        
     104      ENDIF 
     105      ! 
     106      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN  
     107         DO jj = 2 , jpjm1 
     108            DO ji = 2 , jpim1 
     109               z2da(ji,jj)  = (  u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 
     110               z2db(ji,jj)  = (  v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 
     111           END DO 
     112         END DO 
     113         CALL lbc_lnk( z2da, 'T', -1. ) 
     114         CALL lbc_lnk( z2db, 'T', -1. ) 
     115         CALL iom_put( "uice_ipa"     , z2da             )       ! ice velocity u component 
     116         CALL iom_put( "vice_ipa"     , z2db             )       ! ice velocity v component 
     117         DO jj = 1, jpj                                  
     118            DO ji = 1, jpi 
     119               z2d(ji,jj)  = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) )  
     120            END DO 
     121         END DO 
     122         CALL iom_put( "icevel"       , z2d              )       ! ice velocity module 
     123      ENDIF 
     124      ! 
     125      IF ( iom_use( "miceage" ) ) THEN  
     126         z2d(:,:) = 0.e0 
    169127         DO jl = 1, jpl 
    170             zmaskitd(:,:,jl) = tmask(:,:,1) 
    171          END DO 
    172          CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    173          CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  )   
    174          CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   &   
    175             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    176          CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   &   
    177             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    178          CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   &   
    179             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    180          CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   &   
    181             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    182          CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   &   
    183             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    184          CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   &   
    185             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    186          CALL histend(nicea, snc4set) 
    187       ENDIF 
    188  
    189       !     !-----------------------------------------------------------------------! 
    190       !     !--2. Computation of instantaneous values                               !  
    191       !     !-----------------------------------------------------------------------! 
    192  
    193       !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    194       !IF( ln_nicep ) THEN 
    195       !   WRITE(numout,*) 
    196       !   WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit 
    197       !   WRITE(numout,*) '~~~~~~~ ' 
    198       !   WRITE(numout,*) ' kindic = ', kindic 
    199       !ENDIF 
    200       !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    201  
    202       !-- calculs des valeurs instantanees 
    203       zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    204       zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    205  
    206       ! Ice surface temperature and some fluxes 
    207       DO jl = 1, jpl 
     128            DO jj = 1, jpj 
     129               DO ji = 1, jpi 
     130                  rswitch    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
     131                  z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 
     132               END DO 
     133            END DO 
     134         END DO 
     135         CALL iom_put( "miceage"     , z2d * z1_365      )        ! mean ice age 
     136      ENDIF 
     137 
     138      IF ( iom_use( "micet" ) ) THEN  
    208139         DO jj = 1, jpj 
    209140            DO ji = 1, jpi 
    210                zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    211                zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)  
    212                zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)  
    213                zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 
    214                zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06)  
    215             END DO 
    216          END DO 
    217       END DO 
    218  
    219       ! Mean sea ice temperature 
    220       CALL lim_var_icetm 
    221  
    222       ! Brine volume 
    223       CALL lim_var_bv 
    224  
    225       DO jj = 2 , jpjm1 
    226          DO ji = 2 , jpim1 
    227             zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    228             zindb  = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 
    229  
    230             zcmo(ji,jj,1)  = at_i(ji,jj) 
    231             zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
    232             zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
    233             zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * rday     ! Bottom thermodynamic ice production 
    234             zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * rday     ! Dynamic ice production (rid/raft) 
    235             zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday     ! Lateral thermodynamic ice production 
    236             zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday     ! Snow ice production ice production 
    237             zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda 
    238  
    239             zcmo(ji,jj,6)  = fbif(ji,jj)*at_i(ji,jj) 
    240             zcmo(ji,jj,7)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
    241             zcmo(ji,jj,8)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
    242             zcmo(ji,jj,9)  = sst_m(ji,jj) 
    243             zcmo(ji,jj,10) = sss_m(ji,jj) 
    244  
    245             zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
    246             zcmo(ji,jj,12) = qsr(ji,jj) 
    247             zcmo(ji,jj,13) = qns(ji,jj) 
    248             zcmo(ji,jj,14) = fhbri(ji,jj) 
    249             zcmo(ji,jj,15) = utau_ice(ji,jj) 
    250             zcmo(ji,jj,16) = vtau_ice(ji,jj) 
    251             zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 
    252             zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 
    253             zcmo(ji,jj,19) = sprecip(ji,jj) 
    254             zcmo(ji,jj,20) = smt_i(ji,jj) 
    255             zcmo(ji,jj,25) = et_i(ji,jj) 
    256             zcmo(ji,jj,26) = et_s(ji,jj) 
    257             zcmo(ji,jj,28) = sfx_bri(ji,jj) 
    258             zcmo(ji,jj,29) = sfx_thd(ji,jj) 
    259  
    260             zcmo(ji,jj,30) = bv_i(ji,jj) 
    261             zcmo(ji,jj,31) = hicol(ji,jj) * zindb 
    262             zcmo(ji,jj,32) = strength(ji,jj) 
    263             zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  ) 
    264             zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday     ! Surface melt 
    265             zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday     ! Bottom melt 
    266             zcmo(ji,jj,36) = divu_i(ji,jj) 
    267             zcmo(ji,jj,37) = shear_i(ji,jj) 
    268             zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday     ! Bottom melt 
    269             zcmo(ji,jj,39) = vt_i(ji,jj)  ! ice volume 
    270             zcmo(ji,jj,40) = vt_s(ji,jj)  ! snow volume 
    271  
    272             zcmo(ji,jj,41) = sfx_mec(ji,jj) 
    273             zcmo(ji,jj,42) = sfx_res(ji,jj) 
    274  
    275             zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday     ! transport of ice volume 
    276  
    277         END DO 
    278       END DO 
    279  
    280       ! 
    281       ! ecriture d'un fichier netcdf 
    282       ! 
    283       niter = niter + 1 
    284 !clem 
    285 !      DO jf = 1 , noumef 
    286 !         ! 
    287 !         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 
    288 !         ! 
    289 !         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. ) 
    290 !         ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. ) 
    291 !         ENDIF 
    292 !         ! 
    293 !         IF( ln_nicep ) THEN  
    294 !            WRITE(numout,*) 
    295 !            WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 
    296 !            WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 
    297 !         ENDIF 
    298 !         IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
    299 !         ! 
    300 !      END DO 
    301 ! 
    302 !      IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    303 !         IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 
    304 !         CALL histclo( nice ) 
    305 !      ENDIF 
    306 !clem 
    307       ! 
    308        CALL iom_put ('iceconc', zcmo(:,:,1) )          ! field1: ice concentration 
    309        CALL iom_put ('icethic_cea', zcmo(:,:,2) )      ! field2: ice thickness (i.e. icethi(:,:)) 
    310        CALL iom_put ('snowthic_cea', zcmo(:,:,3))      ! field3: snow thickness 
    311        CALL iom_put ('icebopr', zcmo(:,:,4) )   ! field4: daily bottom thermo ice production 
    312        CALL iom_put ('icedypr', zcmo(:,:,5) )   ! field5: daily dynamic ice production 
    313        CALL iom_put ('ioceflxb', zcmo(:,:,6) )         ! field6: Oceanic flux at the ice base 
    314        CALL iom_put ('uice_ipa', zcmo(:,:,7) )         ! field7: ice velocity u component 
    315        CALL iom_put ('vice_ipa', zcmo(:,:,8) )         ! field8: ice velocity v component 
    316        CALL iom_put ('isst', zcmo(:,:,9) )             ! field 9: sea surface temperature 
    317        CALL iom_put ('isss', zcmo(:,:,10) )            ! field 10: sea surface salinity 
    318        CALL iom_put ('qt_oce', zcmo(:,:,11) )           ! field 11: total flux at ocean surface 
    319        CALL iom_put ('qsr_oce', zcmo(:,:,12) )          ! field 12: solar flux at ocean surface 
    320        CALL iom_put ('qns_oce', zcmo(:,:,13) )          ! field 13: non-solar flux at ocean surface 
    321        !CALL iom_put ('hfbri', fhbri )                  ! field 14: heat flux due to brine release 
    322        CALL iom_put( 'utau_ice', zcmo(:,:,15)  )     ! Wind stress over ice along i-axis at I-point 
    323        CALL iom_put( 'vtau_ice', zcmo(:,:,16) )     ! Wind stress over ice along j-axis at I-point 
    324        CALL iom_put ('qsr_io', zcmo(:,:,17) )          ! field 17: solar flux at ice/ocean surface 
    325        CALL iom_put ('qns_io', zcmo(:,:,18) )          ! field 18: non-solar flux at ice/ocean surface 
    326        !CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip           
    327        CALL iom_put ('micesalt', zcmo(:,:,20) )        ! field 20 :mean ice salinity 
    328        CALL iom_put ('miceage', zcmo(:,:,21) / 365)    ! field 21: mean ice age 
    329        CALL iom_put ('icelapr',zcmo(:,:,22) )   ! field 22: daily lateral thermo ice prod. 
    330        CALL iom_put ('icesipr',zcmo(:,:,23) )   ! field 23: daily snowice ice prod. 
    331        CALL iom_put ('micet', zcmo(:,:,24) )           ! field 24: mean ice temperature 
    332        CALL iom_put ('icehc', zcmo(:,:,25) )           ! field 25: ice total heat content 
    333        CALL iom_put ('isnowhc', zcmo(:,:,26) )         ! field 26: snow total heat content 
    334        CALL iom_put ('icest', zcmo(:,:,27) )           ! field 27: ice surface temperature 
    335        CALL iom_put ('sfxbri', zcmo(:,:,28) * rday )           ! field 28: brine salt flux 
    336        CALL iom_put ('sfxthd', zcmo(:,:,29) * rday )           ! field 29: equivalent FW salt flux 
    337        CALL iom_put ('ibrinv', zcmo(:,:,30) *100 )     ! field 30: brine volume 
    338        CALL iom_put ('icecolf', zcmo(:,:,31) )         ! field 31: frazil ice collection thickness 
    339        CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 )  ! field 32: ice strength 
    340        CALL iom_put ('icevel', zcmo(:,:,33) )          ! field 33: ice velocity 
    341        CALL iom_put ('isume', zcmo(:,:,34) )    ! field 34: surface melt 
    342        CALL iom_put ('ibome', zcmo(:,:,35) )     ! field 35: bottom melt 
    343        CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8)    ! field 36: divergence 
    344        CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 )  ! field 37: shear 
    345        CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate 
    346        CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume 
    347        CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume 
    348        CALL iom_put ('sfxmec', zcmo(:,:,41) * rday )           ! field 41: salt flux from ridging rafting 
    349        CALL iom_put ('sfxres', zcmo(:,:,42) * rday )           ! field 42: salt flux from limupdate (resultant) 
    350        CALL iom_put ('icetrp', zcmo(:,:,43) )    ! field 43: ice volume transport 
    351  
    352       !----------------------------- 
    353       ! Thickness distribution file 
    354       !----------------------------- 
    355       IF( add_diag_swi == 1 ) THEN 
    356  
    357          DO jl = 1, jpl  
    358             CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. ) 
    359             CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. ) 
    360             CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. ) 
    361             CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. ) 
    362             CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. ) 
    363          END DO 
    364  
    365          ! Compute ice age 
     141               z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 
     142            END DO 
     143         END DO 
     144         CALL iom_put( "micet"       , z2d               )        ! mean ice temperature 
     145      ENDIF 
     146      ! 
     147      IF ( iom_use( "icest" ) ) THEN  
     148         z2d(:,:) = 0.e0 
     149         DO jl = 1, jpl 
     150            DO jj = 1, jpj 
     151               DO ji = 1, jpi 
     152                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 
     153               END DO 
     154            END DO 
     155         END DO 
     156         CALL iom_put( "icest"       , z2d              )        ! ice surface temperature 
     157      ENDIF 
     158 
     159      IF ( iom_use( "icecolf" ) ) THEN  
     160         DO jj = 1, jpj 
     161            DO ji = 1, jpi 
     162               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 
     163               z2d(ji,jj) = hicol(ji,jj) * rswitch 
     164            END DO 
     165         END DO 
     166         CALL iom_put( "icecolf"     , z2d              )        ! frazil ice collection thickness 
     167      ENDIF 
     168 
     169      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature 
     170      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity 
     171      CALL iom_put( "iceconc"     , at_i                )        ! ice concentration 
     172      CALL iom_put( "icevolu"     , vt_i                )        ! ice volume = mean ice thickness over the cell 
     173      CALL iom_put( "icehc"       , et_i                )        ! ice total heat content 
     174      CALL iom_put( "isnowhc"     , et_s                )        ! snow total heat content 
     175      CALL iom_put( "ibrinv"      , bv_i * 100._wp      )        ! brine volume 
     176      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point 
     177      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point 
     178      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation  
     179      CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity 
     180 
     181      CALL iom_put( "icestr"      , strength * 0.001    )        ! ice strength 
     182      CALL iom_put( "idive"       , divu_i * 1.0e8      )        ! divergence 
     183      CALL iom_put( "ishear"      , shear_i * 1.0e8     )        ! shear 
     184      CALL iom_put( "snowvol"     , vt_s                )        ! snow volume 
     185       
     186      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport 
     187      CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport 
     188      CALL iom_put( "saltrp"      , diag_trp_smv * rday * rhoic ) ! salt content transport 
     189      CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2) 
     190      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2) 
     191 
     192      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from brines 
     193      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from brines 
     194      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from brines 
     195      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from brines 
     196      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from brines 
     197      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting 
     198      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant) 
     199      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines 
     200      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux 
     201 
     202      ztmp = rday / rhoic 
     203      CALL iom_put( "vfxres"     , wfx_res * ztmp       )        ! daily prod./melting due to limupdate  
     204      CALL iom_put( "vfxopw"     , wfx_opw * ztmp       )        ! daily lateral thermodynamic ice production 
     205      CALL iom_put( "vfxsni"     , wfx_sni * ztmp       )        ! daily snowice ice production 
     206      CALL iom_put( "vfxbog"     , wfx_bog * ztmp       )        ! daily bottom thermodynamic ice production 
     207      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp       )        ! daily dynamic ice production (rid/raft) 
     208      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt  
     209      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt  
     210      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt  
     211      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt  
     212      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow)  
     213      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow) 
     214       
     215      CALL iom_put( "afxtot"     , afx_tot * rday       )        ! concentration tendency (total) 
     216      CALL iom_put( "afxdyn"     , afx_dyn * rday       )        ! concentration tendency (dynamics) 
     217      CALL iom_put( "afxthd"     , afx_thd * rday       )        ! concentration tendency (thermo) 
     218 
     219      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   !   
     220      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   !   
     221      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   !   
     222      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   !   
     223      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   !   
     224      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   !   
     225      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   !   
     226      CALL iom_put ('hfxerr'     , hfx_err(:,:)         )   !   
     227      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   !   
     228       
     229      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   !   
     230      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   !   
     231      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   !   
     232      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   !   
     233      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   !   
     234      CALL iom_put ('hfxtur'     , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base  
     235      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice  
     236      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip  
     237       
     238      !-------------------------------- 
     239      ! Output values for each category 
     240      !-------------------------------- 
     241      CALL iom_put( "iceconc_cat"      , a_i         )        ! area for categories 
     242      CALL iom_put( "icethic_cat"      , ht_i        )        ! thickness for categories 
     243      CALL iom_put( "snowthic_cat"     , ht_s        )        ! snow depth for categories 
     244      CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories 
     245 
     246      ! ice temperature 
     247      IF ( iom_use( "icetemp_cat" ) ) THEN  
     248         zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 
     249         CALL iom_put( "icetemp_cat"   , zt_i - rt0  ) 
     250      ENDIF 
     251       
     252      ! snow temperature 
     253      IF ( iom_use( "snwtemp_cat" ) ) THEN  
     254         zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 
     255         CALL iom_put( "snwtemp_cat"   , zt_s - rt0  ) 
     256      ENDIF 
     257 
     258      ! Compute ice age 
     259      IF ( iom_use( "iceage_cat" ) ) THEN  
    366260         DO jl = 1, jpl  
    367261            DO jj = 1, jpj 
    368262               DO ji = 1, jpi 
    369                   zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
    370                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 
     263                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 
     264                  rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 
     265                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 
    371266               END DO 
    372267            END DO 
    373268         END DO 
    374  
    375          ! Compute brine volume 
     269         CALL iom_put( "iceage_cat"   , zoi * z1_365 )        ! ice age for categories 
     270      ENDIF 
     271 
     272      ! Compute brine volume 
     273      IF ( iom_use( "brinevol_cat" ) ) THEN  
    376274         zei(:,:,:) = 0._wp 
    377275         DO jl = 1, jpl  
     
    379277               DO jj = 1, jpj 
    380278                  DO ji = 1, jpi 
    381                      zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
    382                      zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
    383                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & 
    384                         zinda / nlay_i 
     279                     rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
     280                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * & 
     281                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 
     282                        rswitch * r1_nlay_i 
    385283                  END DO 
    386284               END DO 
    387285            END DO 
    388286         END DO 
    389  
    390          DO jl = 1, jpl  
    391             CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. ) 
    392          END DO 
    393  
    394          CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area 
    395          CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness 
    396          CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth 
    397          CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity 
    398          CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age 
    399          CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume 
    400  
    401          !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
    402          !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
    403          !     not yet implemented 
    404  
    405          IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    406             IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 
    407             CALL histclo( nicea )  
    408          ENDIF 
    409          ! 
    410       ENDIF 
    411  
    412       CALL wrk_dealloc( jpi, jpj, zfield ) 
    413       CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    414       CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
     287         CALL iom_put( "brinevol_cat"     , zei      )        ! brine volume for categories 
     288      ENDIF 
     289 
     290      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
     291      !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
     292      !     not yet implemented 
     293       
     294      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s ) 
     295      CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db ) 
    415296 
    416297      IF( nn_timing == 1 )  CALL timing_stop('limwri') 
     
    419300#endif 
    420301 
    421    SUBROUTINE lim_wri_init 
    422       !!------------------------------------------------------------------- 
    423       !!                    ***   ROUTINE lim_wri_init  *** 
    424       !!                 
    425       !! ** Purpose :   ??? 
    426       !! 
    427       !! ** Method  : Read the namicewri namelist and check the parameter  
    428       !!       values called at the first timestep (nit000) 
    429       !! 
    430       !! ** input   :   Namelist namicewri 
    431       !!------------------------------------------------------------------- 
    432       INTEGER ::   nf      ! ??? 
    433       INTEGER ::   ios     ! Local integer output status for namelist read 
    434  
    435       TYPE FIELD  
    436          CHARACTER(len = 35) :: ztitle  
    437          CHARACTER(len = 8 ) :: zname           
    438          CHARACTER(len = 8 ) :: zunit 
    439          INTEGER             :: znc    
    440          REAL                :: zcmulti  
    441          REAL                :: zcadd         
    442       END TYPE FIELD 
    443  
    444       TYPE(FIELD) ::  & 
    445          field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   & 
    446          field_7 , field_8 , field_9 , field_10, field_11, field_12,   & 
    447          field_13, field_14, field_15, field_16, field_17, field_18,   & 
    448          field_19, field_20, field_21, field_22, field_23, field_24,   & 
    449          field_25, field_26, field_27, field_28, field_29, field_30,   & 
    450          field_31, field_32, field_33, field_34, field_35, field_36,   & 
    451          field_37, field_38, field_39, field_40, field_41, field_42, field_43 
    452  
    453       TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 
    454       ! 
    455       NAMELIST/namiceout/ noumef, & 
    456          field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   & 
    457          field_7 , field_8 , field_9 , field_10, field_11, field_12,   & 
    458          field_13, field_14, field_15, field_16, field_17, field_18,   & 
    459          field_19, field_20, field_21, field_22, field_23, field_24,   & 
    460          field_25, field_26, field_27, field_28, field_29, field_30,   & 
    461          field_31, field_32, field_33, field_34, field_35, field_36,   & 
    462          field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi 
    463       !!------------------------------------------------------------------- 
    464       REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs 
    465       READ  ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901) 
    466 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp ) 
    467  
    468       REWIND( numnam_ice_cfg )              ! Namelist namiceout in configuration namelist : Ice outputs 
    469       READ  ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 ) 
    470 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp ) 
    471       IF(lwm) WRITE ( numoni, namiceout ) 
    472  
    473       zfield(1)  = field_1 
    474       zfield(2)  = field_2 
    475       zfield(3)  = field_3 
    476       zfield(4)  = field_4 
    477       zfield(5)  = field_5 
    478       zfield(6)  = field_6 
    479       zfield(7)  = field_7 
    480       zfield(8)  = field_8 
    481       zfield(9)  = field_9 
    482       zfield(10) = field_10 
    483       zfield(11) = field_11 
    484       zfield(12) = field_12 
    485       zfield(13) = field_13 
    486       zfield(14) = field_14 
    487       zfield(15) = field_15 
    488       zfield(16) = field_16 
    489       zfield(17) = field_17 
    490       zfield(18) = field_18 
    491       zfield(19) = field_19 
    492       zfield(20) = field_20 
    493       zfield(21) = field_21 
    494       zfield(22) = field_22 
    495       zfield(23) = field_23 
    496       zfield(24) = field_24 
    497       zfield(25) = field_25 
    498       zfield(26) = field_26 
    499       zfield(27) = field_27 
    500       zfield(28) = field_28 
    501       zfield(29) = field_29 
    502       zfield(30) = field_30 
    503       zfield(31) = field_31 
    504       zfield(32) = field_32 
    505       zfield(33) = field_33 
    506       zfield(34) = field_34 
    507       zfield(35) = field_35 
    508       zfield(36) = field_36 
    509       zfield(37) = field_37 
    510       zfield(38) = field_38 
    511       zfield(39) = field_39 
    512       zfield(40) = field_40 
    513       zfield(41) = field_41 
    514       zfield(42) = field_42 
    515       zfield(43) = field_43 
    516  
    517       DO nf = 1, noumef 
    518          titn  (nf) = zfield(nf)%ztitle 
    519          nam   (nf) = zfield(nf)%zname 
    520          uni   (nf) = zfield(nf)%zunit 
    521          nc    (nf) = zfield(nf)%znc 
    522          cmulti(nf) = zfield(nf)%zcmulti 
    523          cadd  (nf) = zfield(nf)%zcadd 
    524       END DO 
    525  
    526       IF(lwp) THEN                        ! control print 
    527          WRITE(numout,*) 
    528          WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs' 
    529          WRITE(numout,*) '~~~~~~~~~~~~' 
    530          WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef 
    531          WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   & 
    532             &            '    multiplicative constant       additive constant ' 
    533          DO nf = 1 , noumef          
    534             WRITE(numout,*) '   ', titn(nf), '   '    , nam   (nf), '      '  , uni (nf),   & 
    535                &            '  ' , nc  (nf),'        ', cmulti(nf), '        ', cadd(nf) 
    536          END DO 
    537          WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    538       ENDIF 
    539       ! 
    540    END SUBROUTINE lim_wri_init 
    541302  
    542303   SUBROUTINE lim_wri_state( kt, kid, kh_i ) 
     
    555316      INTEGER, INTENT( in ) ::   kid , kh_i        
    556317      !!---------------------------------------------------------------------- 
    557       !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz ) 
    558  
    559       CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    560       CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    561       CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    562       CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    563       CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    564       CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    565       CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    566       CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    567       CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    568       CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    569       CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    570       CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    571       CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    572       CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    573       CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    574       CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    575       CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    576       CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    577       CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    578       CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    579       CALL histdef( kid, "iisfxthd", "Salt flux from thermo"   , ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    580       CALL histdef( kid, "iisfxmec", "Salt flux from dynmics"  , ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    581       CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    582  
    583  
    584       !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    585       !CALL histdef( kid, "iice_hid", "Ice thickness by cat"    , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    586       !CALL histdef( kid, "iice_hsd", "Snow thickness by cat"   , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    587       !CALL histdef( kid, "iice_std", "Ice salinity by cat"     , "PSU"    , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     318 
     319      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      ,   & 
     320      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     321      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      ,   & 
     322      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     323      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      ,   & 
     324      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     325      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    ,   & 
     326      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     327      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    ,   & 
     328      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     329      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa",   & 
     330      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     331      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa",   & 
     332      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     333      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2" ,   & 
     334      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     335      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" ,   & 
     336      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     337      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   & 
     338      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     339      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    ,   & 
     340      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     341      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      ,   & 
     342      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     343      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1",   & 
     344      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     345      CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"    ,   & 
     346      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     347      CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"    ,   & 
     348      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     349      CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"    ,   & 
     350      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     351      CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"    ,   & 
     352      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     353      CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"    ,   & 
     354      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     355      CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"    ,   & 
     356      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     357      CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"    ,   & 
     358      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     359      CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics"  , ""       ,   & 
     360      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     361      CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""       ,   & 
     362      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    588363 
    589364      CALL histend( kid, snc4set )   ! end of the file definition 
     
    591366      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )     
    592367      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) ) 
    593       CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) ) 
     368      CALL histwrite( kid, "iicetemp", kt, tm_i - rt0    , jpi*jpj, (/1/) ) 
    594369      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
    595370      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 
     
    603378      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) ) 
    604379 
    605       CALL histwrite( kid, "iicebopr", kt, diag_bot_gr        , jpi*jpj, (/1/) ) 
    606       CALL histwrite( kid, "iicedypr", kt, diag_dyn_gr        , jpi*jpj, (/1/) ) 
    607       CALL histwrite( kid, "iicelapr", kt, diag_lat_gr        , jpi*jpj, (/1/) ) 
    608       CALL histwrite( kid, "iicesipr", kt, diag_sni_gr        , jpi*jpj, (/1/) ) 
    609       CALL histwrite( kid, "iicerepr", kt, diag_res_pr        , jpi*jpj, (/1/) ) 
    610       CALL histwrite( kid, "iicebome", kt, diag_bot_me        , jpi*jpj, (/1/) ) 
    611       CALL histwrite( kid, "iicesume", kt, diag_sur_me        , jpi*jpj, (/1/) ) 
    612       CALL histwrite( kid, "iisfxthd", kt, sfx_thd        , jpi*jpj, (/1/) ) 
    613       CALL histwrite( kid, "iisfxmec", kt, sfx_mec        , jpi*jpj, (/1/) ) 
     380      CALL histwrite( kid, "iicebopr", kt, wfx_bog        , jpi*jpj, (/1/) ) 
     381      CALL histwrite( kid, "iicedypr", kt, wfx_dyn        , jpi*jpj, (/1/) ) 
     382      CALL histwrite( kid, "iicelapr", kt, wfx_opw        , jpi*jpj, (/1/) ) 
     383      CALL histwrite( kid, "iicesipr", kt, wfx_sni        , jpi*jpj, (/1/) ) 
     384      CALL histwrite( kid, "iicerepr", kt, wfx_res        , jpi*jpj, (/1/) ) 
     385      CALL histwrite( kid, "iicebome", kt, wfx_bom        , jpi*jpj, (/1/) ) 
     386      CALL histwrite( kid, "iicesume", kt, wfx_sum        , jpi*jpj, (/1/) ) 
     387      CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn        , jpi*jpj, (/1/) ) 
    614388      CALL histwrite( kid, "iisfxres", kt, sfx_res        , jpi*jpj, (/1/) ) 
    615389 
    616       !CALL histwrite( kid, "iice_itd", kt, a_i  , jpi*jpj*jpl, (/1/)  )   ! area 
    617       !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/)  )   ! thickness 
    618       !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/)  )   ! snow depth 
    619       !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/)  )   ! salinity 
     390      ! Close the file 
     391      ! ----------------- 
     392      !CALL histclo( kid ) 
    620393 
    621394    END SUBROUTINE lim_wri_state 
Note: See TracChangeset for help on using the changeset viewer.