Changeset 508


Ignore:
Timestamp:
2006-10-03T17:58:55+02:00 (14 years ago)
Author:
opalod
Message:

nemo_v1_update_071:RB: add iom for restart and reorganization of restart

Location:
trunk/NEMO
Files:
27 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/LIM_SRC/dom_ice.F90

    r420 r508  
    44   !! LIM Sea Ice :   Domain  variables 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   2.0  !  03-08  (C. Ethe)  Free form and module 
     6   !! History :   2.0  !  03-08  (C. Ethe)  Free form and module 
     7   !!---------------------------------------------------------------------- 
     8 
    89   !!---------------------------------------------------------------------- 
    910   !!   LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    1011   !! $Header$ 
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     12   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1213   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1414   USE par_ice 
    1515 
     
    1717   PRIVATE 
    1818 
    19    !! * Share module variables 
    20    LOGICAL, PUBLIC ::       &  !: 
    21       l_jeq     = .TRUE. ,  &  !: Equator inside the domain flag 
    22       ln_limini = .FALSE.,  &  !: Ice initialization state 
    23       ln_limdmp = .FALSE.      !: Ice damping 
     19   LOGICAL, PUBLIC ::   l_jeq     = .TRUE.     !: Equator inside the domain flag 
     20   LOGICAL, PUBLIC ::   ln_limini = .FALSE.    !: Ice initialization state 
     21   LOGICAL, PUBLIC ::   ln_limdmp = .FALSE.    !: Ice damping 
    2422 
    25    INTEGER, PUBLIC ::   &  !: 
    26       njeq , njeqm1        !: j-index of the equator if it is inside the domain 
    27       !                    !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
     23   INTEGER, PUBLIC ::   njeq , njeqm1          !: j-index of the equator if it is inside the domain 
     24      !                                        !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
    2825 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    30       fs2cor ,          &  !: coriolis factor 
    31       fcor   ,          &  !: coriolis coefficient 
    32       covrai ,          &  !: sine of geographic latitude 
    33       area   ,          &  !: surface of grid cell  
    34       tms    , tmu         !: temperature and velocity points masks 
    35  
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) ::   &  !: 
    37       wght   ,          &  !: weight of the 4 neighbours to compute averages 
    38       akappa ,          &  !: first group of metric coefficients 
    39       bkappa               !: third group of metric coefficients 
    40  
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   &  !: 
    42       alambd               !: second group of metric coefficients 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   fs2cor , fcor,   &  !: coriolis factor and coeficient 
     27      &                                              covrai ,         &  !: sine of geographic latitude 
     28      &                                              area   ,         &  !: surface of grid cell  
     29      &                                              tms    , tmu        !: temperature and velocity points masks 
     30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght   ,         &  !: weight of the 4 neighbours to compute averages 
     31      &                                              akappa , bkappa     !: first and third group of metric coefficients 
     32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd   !: second group of metric coefficients 
    4333 
    4434   !!====================================================================== 
  • trunk/NEMO/LIM_SRC/iceini.F90

    r391 r508  
    44   !!   Sea-ice model : LIM Sea ice model Initialization 
    55   !!====================================================================== 
     6   !! History :   1.0  !  02-08  (G. Madec)  F90: Free form and modules 
     7   !!             2.0  !  03-08  (C. Ethe)  add ice_run 
     8   !!---------------------------------------------------------------------- 
    69#if defined key_ice_lim 
    710   !!---------------------------------------------------------------------- 
    811   !!   'key_ice_lim' :                                   LIM sea-ice model 
    912   !!---------------------------------------------------------------------- 
     13   !!---------------------------------------------------------------------- 
    1014   !!   ice_init       : sea-ice model initialization 
     15   !!   ice_run        : Definition some run parameter for ice model 
    1116   !!---------------------------------------------------------------------- 
    1217   USE dom_oce 
     
    1924   USE limmsh 
    2025   USE limistate 
    21    USE limrst 
     26   USE limrst    
    2227   USE ini1d           ! initialization of the 1D configuration 
    23  
     28       
    2429   IMPLICIT NONE 
    2530   PRIVATE 
    2631 
    27    !! * Routine accessibility 
    28    PUBLIC ice_init                 ! called by opa.F90 
     32   PUBLIC   ice_init                 ! called by opa.F90 
    2933 
    30    !! * Share Module variables 
    31    LOGICAL , PUBLIC  ::   & !!! ** init namelist (namicerun) ** 
    32       ln_limdyn   = .TRUE.   !: flag for ice dynamics (T) or not (F) 
    33    INTEGER , PUBLIC  ::   &  !: 
    34       nstart ,            &  !: iteration number of the begining of the run  
    35       nlast  ,            &  !: iteration number of the end of the run  
    36       nitrun ,            &  !: number of iteration 
    37       numit                  !: iteration number 
    38    REAL(wp), PUBLIC  ::   &  !: 
    39       hsndif = 0.e0 ,     &  !: computation of temp. in snow (0) or not (9999) 
    40       hicdif = 0.e0 ,     &  !: computation of temp. in ice (0) or not (9999) 
    41       tpstot                 !: time of the run in seconds 
    42    REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !: 
    43       acrit  = (/ 1.e-06 , 1.e-06 /)    !: minimum fraction for leads in  
    44       !                                   !  north and south hemisphere 
     34   LOGICAL , PUBLIC               ::   ln_limdyn = .TRUE.   !: flag for ice dynamics (T) or not (F) 
     35   REAL(wp), PUBLIC               ::   hsndif = 0.e0        !: computation of temp. in snow (0) or not (9999) 
     36   REAL(wp), PUBLIC               ::   hicdif = 0.e0        !: computation of temp. in ice (0) or not (9999) 
     37   REAL(wp), PUBLIC, DIMENSION(2) ::   acrit  = (/ 1.e-06 , 1.e-06 /)    !: minimum fraction for leads in  
     38      !                                                                  !  north and south hemisphere 
    4539   !!---------------------------------------------------------------------- 
    4640   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     
    5650      !! 
    5751      !! ** purpose :    
    58       !! 
    59       !! History : 
    60       !!   8.5  !  02-08  (G. Madec)  F90: Free form and modules 
    6152      !!---------------------------------------------------------------------- 
    62        CHARACTER(len=80) :: namelist_icename 
    63         
     53      CHARACTER(len=80) :: namelist_icename 
     54      !!---------------------------------------------------------------------- 
     55      ! 
    6456      ! Open the namelist file  
    6557      namelist_icename = 'namelist_ice' 
    66             
    6758      CALL ctlopn(numnam_ice,namelist_icename,'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    6859                     1,numout,.FALSE.,1)       
    69  
    7060      CALL ice_run                    !  read in namelist some run parameters 
    7161                  
     
    8373      ! Initial sea-ice state 
    8474      IF( .NOT.ln_rstart ) THEN 
    85          numit = 0 
    8675         CALL lim_istate              ! start from rest: sea-ice deduced from sst 
    8776      ELSE 
    88          CALL lim_rst_read( numit )   ! start from a restart file 
     77         CALL lim_rst_read            ! start from a restart file 
    8978      ENDIF 
    9079       
     
    9483      alb_ice(:,:) = albege(:,:)      ! sea-ice albedo 
    9584# endif 
    96        
    97       nstart = numit  + nfice       
    98       nitrun = nitend - nit000 + 1  
    99       nlast  = numit  + nitrun  
    100  
    101       IF( nstock == 0  )  nstock = nlast + 1 
    102  
     85      ! 
    10386   END SUBROUTINE ice_init 
    10487 
     
    11497      !! 
    11598      !! ** input   :   Namelist namicerun 
    116       !! 
    117       !! history : 
    118       !!   2.0  !  03-08 (C. Ethe)  Original code 
    11999      !!------------------------------------------------------------------- 
    120  
    121100      NAMELIST/namicerun/ ln_limdyn, acrit, hsndif, hicdif 
    122101      !!------------------------------------------------------------------- 
    123  
    124       !                                           ! Read Namelist namicerun  
    125       REWIND ( numnam_ice ) 
     102      !                     
     103      REWIND ( numnam_ice )                       ! Read Namelist namicerun  
    126104      READ   ( numnam_ice , namicerun ) 
    127105 
    128       IF( lk_cfg_1d  )  ln_limdyn = .FALSE.       ! No ice transport in 1D configuration 
     106      IF( lk_cfg_1d  )   ln_limdyn = .FALSE.      ! No ice transport in 1D configuration 
    129107 
    130108      IF(lwp) THEN 
     
    137115         WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif 
    138116      ENDIF 
     117      ! 
    139118   END SUBROUTINE ice_run 
    140119 
  • trunk/NEMO/LIM_SRC/icestp.F90

    r420 r508  
    44   !!   Sea-Ice model : LIM Sea ice model time-stepping 
    55   !!====================================================================== 
     6   !! History :   1.0  !  99-11  (M. Imbard)  Original code 
     7   !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf. 
     8   !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_ice_lim 
    711   !!---------------------------------------------------------------------- 
    812   !!   'key_ice_lim' :                                   Lim sea-ice model 
     13   !!---------------------------------------------------------------------- 
    914   !!---------------------------------------------------------------------- 
    1015   !!   ice_stp       : sea-ice model time-stepping 
     
    2126   USE taumod 
    2227   USE ice 
    23    USE iceini 
    2428   USE ocesbc 
    2529   USE lbclnk 
     
    3741   PRIVATE 
    3842 
    39    !! * Routine accessibility 
    40    PUBLIC ice_stp  ! called by step.F90 
     43   PUBLIC   ice_stp    ! called by step.F90 
    4144 
    4245   !! * Substitutions 
     
    4649   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    4750   !! $Header$  
    48    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     51   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4952   !!----------------------------------------------------- 
    5053 
     
    6467      !!              - save the outputs  
    6568      !!              - save the outputs for restart when necessary 
    66       !! 
    67       !! History : 
    68       !!   1.0  !  99-11  (M. Imbard)  Original code 
    69       !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf. 
    70       !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module 
    7169      !!---------------------------------------------------------------------- 
    72       !! * Arguments 
    73       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    74  
    75       !! * Local declarations 
    76       INTEGER   ::   ji, jj   ! dummy loop indices 
    77  
    78       REAL(wp) , DIMENSION(jpi,jpj)    :: & 
    79          zsss_io, zsss2_io, zsss3_io          ! tempory workspaces 
     70      INTEGER, INTENT(in)          ::   kt       ! ocean time-step index 
     71 
     72      INTEGER                      ::   ji, jj   ! dummy loop indices 
     73      REAL(wp), DIMENSION(jpi,jpj) ::   zsss_io, zsss2_io, zsss3_io          ! tempory workspaces 
    8074      !!---------------------------------------------------------------------- 
    8175 
     
    201195         ENDIF 
    202196 
    203          ! Ice model call 
    204          numit = numit + nfice  
     197         !                                                           !-----------------------! 
     198         CALL lim_rst_opn( kt )                                   ! Open Ice restart file ! 
     199         !                                                           !-----------------------! 
    205200 
    206201         !                                                           !--------------! 
    207          CALL lim_dyn                                                ! Ice dynamics !   ( rheology/dynamics ) 
     202         CALL lim_dyn( kt )                                          ! Ice dynamics !   ( rheology/dynamics ) 
    208203         !                                                           !--------------! 
    209204         IF(ln_ctl) THEN 
     
    214209 
    215210         !                                                           !---------------! 
    216          CALL lim_trp                                                ! Ice transport !  ( Advection/diffusion ) 
     211         CALL lim_trp( kt )                                          ! Ice transport !  ( Advection/diffusion ) 
    217212         !                                                           !---------------! 
    218213         IF(ln_ctl) THEN 
     
    222217 
    223218         !                                                           !-------------! 
    224          IF( ln_limdmp ) CALL lim_dmp(kt)                            ! Ice damping ! 
     219         IF( ln_limdmp ) CALL lim_dmp( kt )                          ! Ice damping ! 
    225220         !                                                           !-------------! 
    226221 
    227222         !                                                           !--------------------! 
    228          CALL lim_thd                                                ! Ice thermodynamics ! 
     223         CALL lim_thd( kt )                                          ! Ice thermodynamics ! 
    229224         !                                                           !--------------------! 
    230225         IF(ln_ctl) THEN 
     
    239234         !                                                           !------------------------------! 
    240235 
    241          IF( MOD( numit, ninfo ) == 0 .OR. ntmoy == 1 )  THEN        !-----------------! 
    242             CALL lim_dia                                             ! Ice Diagnostics ! 
     236         IF( MOD( kt + nfice -1, ninfo ) == 0 .OR. ntmoy == 1 )  THEN        !-----------------! 
     237            CALL lim_dia( kt )                                    ! Ice Diagnostics ! 
    243238         ENDIF                                                       !-----------------! 
    244239 
    245240         !                                                           !-------------! 
    246          CALL lim_wri                                                ! Ice outputs ! 
    247          !                                                           !-------------! 
    248  
    249          IF( MOD( numit, nstock ) == 0 .OR. numit == nlast ) THEN 
    250             !                                                        !------------------! 
    251             CALL lim_rst_write( numit )                              ! Ice restart file ! 
    252             !                                                        !------------------! 
    253          ENDIF 
     241         CALL lim_wri( kt )                                          ! Ice outputs ! 
     242         !                                                           !-------------! 
     243 
     244         !                                                           !------------------------! 
     245         IF( lrst_ice ) CALL lim_rst_write( kt )                  ! Write Ice restart file ! 
     246         !                                                           !------------------------! 
    254247 
    255248         ! Re-initialization of forcings 
     
    271264         dqla_ice(:,:) = 0.e0 
    272265#endif 
    273  
    274266      ENDIF 
    275  
     267      ! 
    276268   END SUBROUTINE ice_stp 
    277269 
  • trunk/NEMO/LIM_SRC/limdia.F90

    r247 r508  
    44   !!                      diagnostics of ice model  
    55   !!====================================================================== 
     6   !! History :   8.0  !  97-06  (Louvain-La-Neuve)  Original code 
     7   !!             8.5  !  02-09  (C. Ethe , G. Madec )  F90: Free form and module 
     8   !!             9.0  !  06-08  (S. Masson)  change frequency output control 
     9   !!------------------------------------------------------------------- 
    610#if defined key_ice_lim 
    711   !!---------------------------------------------------------------------- 
    812   !!   'key_ice_lim' :                                   LIM sea-ice model 
     13   !!---------------------------------------------------------------------- 
    914   !!---------------------------------------------------------------------- 
    1015   !!   lim_dia      : computation of the time evolution of keys var. 
    1116   !!   lim_dia_init : initialization and namelist read 
    1217   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1418   USE phycst          !  
    1519   USE par_ice         ! ice parameters 
     
    1822   USE dom_ice         ! 
    1923   USE ice             ! 
    20    USE iceini          ! 
    2124   USE limistate       ! 
    2225   USE in_out_manager  ! I/O manager 
     
    2528   PRIVATE 
    2629 
    27    !! * Routine accessibility 
    28    PUBLIC lim_dia       ! called by ice_step 
    29  
    30    !! * Shared module variables 
    31    INTEGER, PUBLIC  ::  &  !: 
    32       ntmoy   = 1 ,     &  !: instantaneous values of ice evolution or averaging ntmoy 
    33       ninfo   = 1          !: frequency of ouputs on file ice_evolu in case of averaging 
    34  
    35    !! * Module variables 
     30   PUBLIC               lim_dia            ! called by ice_step 
     31   INTEGER, PUBLIC ::   ntmoy   = 1 ,   &  !: instantaneous values of ice evolution or averaging ntmoy 
     32      &                 ninfo   = 1        !: frequency of ouputs on file ice_evolu in case of averaging 
     33 
    3634   INTEGER, PARAMETER ::   &  ! Parameters for outputs to files "evolu" 
    3735      jpinfmx = 100         ,    &  ! maximum number of key variables 
     
    4644      naveg                ! number of step for accumulation before averaging 
    4745 
    48    CHARACTER(len=8) ::   & 
    49       fmtinf  = '1PE13.5 ' ! format of the output values   
    50    CHARACTER(len=30) ::   & 
    51       fmtw  ,           &  ! formats 
    52       fmtr  ,           &  ! ??? 
    53       fmtitr               ! ??? 
    54    CHARACTER(len=jpchsep), DIMENSION(jpinfmx) ::   & 
    55       titvar               ! title of key variables 
     46   CHARACTER(len= 8) ::   fmtinf  = '1PE13.5 ' ! format of the output values   
     47   CHARACTER(len=30) ::   fmtw  ,           &  ! formats 
     48      &                   fmtr  ,           &  ! ??? 
     49      &                   fmtitr               ! ??? 
     50   CHARACTER(len=jpchsep), DIMENSION(jpinfmx) ::   titvar               ! title of key variables 
    5651  
    57    REAL(wp) ::   & 
    58       epsi06 = 1.e-06      ! ??? 
    59    REAL(wp), DIMENSION(jpinfmx) ::  & 
    60       vinfom               ! temporary working space 
    61    REAL(wp), DIMENSION(jpi,jpj) ::   & 
    62       aire                 ! masked grid cell area 
     52   REAL(wp)                     ::   epsi06 = 1.e-06      ! ??? 
     53   REAL(wp), DIMENSION(jpinfmx) ::   vinfom               ! temporary working space 
     54   REAL(wp), DIMENSION(jpi,jpj) ::   aire                 ! masked grid cell area 
    6355 
    6456   !! * Substitutions 
     
    6759   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    6860   !! $Header$  
    69    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     61   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7062   !!---------------------------------------------------------------------- 
    7163 
    7264CONTAINS 
    7365 
    74    SUBROUTINE lim_dia 
     66   SUBROUTINE lim_dia( kt ) 
    7567      !!-------------------------------------------------------------------- 
    7668      !!                  ***  ROUTINE lim_dia  *** 
     
    7870      !! ** Purpose : Computation and outputs on file ice.evolu  
    7971      !!      the temporal evolution of some key variables 
     72      !!------------------------------------------------------------------- 
     73      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    8074      !! 
    81       !! History : 
    82       !!   8.0  !  97-06  (Louvain-La-Neuve)  Original code 
    83       !!   8.5  !  02-09  (C. Ethe , G. Madec )  F90: Free form and module 
     75      INTEGER  ::   jv,ji, jj   ! dummy loop indices 
     76      INTEGER  ::   nv          ! indice of variable  
     77      REAL(wp) ::   zarea    , zldarea  ,    &  ! sea-ice and leads area 
     78         &          zextent15, zextent85,    &  ! sea-ice extent (15% and 85%) 
     79         &          zicevol  , zsnwvol  ,    &  ! sea-ice and snow volume volume 
     80         &          zicespd                     ! sea-ice velocity 
     81      REAL(wp), DIMENSION(jpinfmx) ::   vinfor  ! temporary working space  
    8482      !!------------------------------------------------------------------- 
    85       !! * Local variables 
    86        INTEGER  ::   jv,ji, jj   ! dummy loop indices 
    87        INTEGER  ::   nv          ! indice of variable  
    88        REAL(wp), DIMENSION(jpinfmx) ::  &  
    89           vinfor           ! temporary working space  
    90        REAL(wp) ::    & 
    91           zarea    ,    &  ! sea ice area 
    92           zldarea  ,    &  ! leads area 
    93           zextent15,    &  ! sea ice extent (15%) 
    94           zextent85,    &  ! sea ice extent (85%) 
    95           zicevol  ,    &  ! sea ice volume 
    96           zsnwvol  ,    &  ! snow volume over sea ice 
    97           zicespd          ! sea ice velocity 
    98        !!------------------------------------------------------------------- 
    99  
    100        IF( numit == nstart )   CALL lim_dia_init   ! initialisation of ice_evolu file       
    101  
    102        ! computation of key variables at each time step    
    103  
    104        nv = 1  
    105        vinfor(nv) = REAL( numit ) 
    106        nv = nv + 1 
    107        vinfor(nv) = nyear 
     83 
     84      IF( kt == nit000 )   CALL lim_dia_init   ! initialisation of ice_evolu file       
     85 
     86      ! computation of key variables at each time step    
     87 
     88      nv = 1  
     89      vinfor(nv) = REAL( kt + nfice - 1 ) 
     90      nv = nv + 1 
     91      vinfor(nv) = nyear 
    10892  
    109        DO jv = nbvt + 1, nvinfo 
    110           vinfor(jv) = 0.e0 
    111        END DO 
    112  
    113        zextent15 = 0.e0 
    114        zextent85 = 0.e0 
    115        ! variables in northern Hemis 
    116        DO jj = njeq, jpjm1 
    117           DO ji = fs_2, fs_jpim1   ! vector opt. 
    118              IF( tms(ji,jj) == 1 ) THEN 
    119                 zarea = ( 1.0 - frld(ji,jj) ) * aire(ji,jj) 
    120                 IF (frld(ji,jj) <= 0.15 ) zextent15 = aire(ji,jj)     
    121                 IF (frld(ji,jj) <= 0.85 ) zextent85 = aire(ji,jj)    
    122                 zldarea = zarea   / MAX( ( 1 - frld(ji,jj) ) , epsi06 ) 
    123                 zicevol = zarea   * hicif(ji,jj) 
    124                 zsnwvol = zarea   * hsnif(ji,jj) 
    125                 zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj)   & 
    126                    &                + v_ice(ji,jj) * v_ice(ji,jj) ) 
    127                 vinfor(nv+ 1) = vinfor(nv+ 1) + zarea 
    128                 vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15 
    129                 vinfor(nv+ 5) = vinfor(nv+ 5) + zextent85 
    130                 vinfor(nv+ 7) = vinfor(nv+ 7) + zldarea 
    131                 vinfor(nv+ 9) = vinfor(nv+ 9) + zicevol 
    132                 vinfor(nv+11) = vinfor(nv+11) + zsnwvol 
    133                 vinfor(nv+13) = vinfor(nv+13) + zicespd 
    134              ENDIF 
    135           END DO 
    136        END DO 
    137        vinfor(nv+13) = SQRT( vinfor(nv+13) / MAX( vinfor(nv+9) , epsi06 ) ) 
     93      DO jv = nbvt + 1, nvinfo 
     94         vinfor(jv) = 0.e0 
     95      END DO 
     96 
     97      zextent15 = 0.e0 
     98      zextent85 = 0.e0 
     99      ! variables in northern Hemis 
     100      DO jj = njeq, jpjm1 
     101         DO ji = fs_2, fs_jpim1   ! vector opt. 
     102            IF( tms(ji,jj) == 1 ) THEN 
     103               zarea = ( 1.0 - frld(ji,jj) ) * aire(ji,jj) 
     104               IF (frld(ji,jj) <= 0.15 ) zextent15 = aire(ji,jj)     
     105               IF (frld(ji,jj) <= 0.85 ) zextent85 = aire(ji,jj)    
     106               zldarea = zarea   / MAX( ( 1 - frld(ji,jj) ) , epsi06 ) 
     107               zicevol = zarea   * hicif(ji,jj) 
     108               zsnwvol = zarea   * hsnif(ji,jj) 
     109               zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj)   & 
     110                  &                + v_ice(ji,jj) * v_ice(ji,jj) ) 
     111               vinfor(nv+ 1) = vinfor(nv+ 1) + zarea 
     112               vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15 
     113               vinfor(nv+ 5) = vinfor(nv+ 5) + zextent85 
     114               vinfor(nv+ 7) = vinfor(nv+ 7) + zldarea 
     115               vinfor(nv+ 9) = vinfor(nv+ 9) + zicevol 
     116               vinfor(nv+11) = vinfor(nv+11) + zsnwvol 
     117               vinfor(nv+13) = vinfor(nv+13) + zicespd 
     118            ENDIF 
     119         END DO 
     120      END DO 
     121      vinfor(nv+13) = SQRT( vinfor(nv+13) / MAX( vinfor(nv+9) , epsi06 ) ) 
    138122 
    139123 
     
    170154     
    171155       ! oututs on file ice_evolu     
    172        IF( MOD( numit , ninfo ) == 0 ) THEN 
     156       IF( MOD( kt + nfice - 1, ninfo ) == 0 ) THEN 
    173157          WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo ) 
    174158          naveg = 0 
     
    177161          END DO 
    178162       ENDIF 
    179    
     163       ! 
    180164    END SUBROUTINE lim_dia 
    181165  
     
    189173       !! 
    190174       !! ** input   : Namelist namicedia 
    191        !! 
    192        !! history : 
    193        !!  8.5  ! 03-08 (C. Ethe) original code 
    194175       !!------------------------------------------------------------------- 
     176       CHARACTER(len=jpchinf) ::   titinf 
     177       INTEGER  ::   jv            ! dummy loop indice 
     178       INTEGER  ::   ntot , ndeb , irecl 
     179       INTEGER  ::   nv            ! indice of variable  
     180       REAL(wp) ::   zxx0, zxx1    ! temporary scalars 
     181 
    195182       NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy 
    196  
    197        INTEGER  ::   jv   ,     &  ! dummy loop indice 
    198           &          ntot ,     & 
    199           &          ndeb ,     & 
    200           &          irecl 
    201  
    202        INTEGER  ::   nv            ! indice of variable  
    203  
    204        REAL(wp) ::   zxx0, zxx1    ! temporary scalars 
    205  
    206        CHARACTER(len=jpchinf) ::   titinf 
    207183       !!------------------------------------------------------------------- 
    208184 
     
    210186       REWIND ( numnam_ice ) 
    211187       READ   ( numnam_ice  , namicedia ) 
     188        
    212189       IF(lwp) THEN 
    213190          WRITE(numout,*) 
     
    228205       nv = nv + 1 
    229206       titvar(nv) = 'T yr'  ! time step in years 
    230        nv = nv + 1 
    231  
     207        
    232208       nbvt = nv - 1 
    233209 
    234        titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2) 
    235        nv = nv + 1 
    236        titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2) 
    237        nv = nv + 1 
    238        titvar(nv) = 'A15N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2) 
    239        nv = nv + 1 
    240        titvar(nv) = 'A15S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2) 
    241        nv = nv + 1 
    242        titvar(nv) = 'A85N'  ! sea ice extent (85%) in the northern Hemisp.(10^12 km2) 
    243        nv = nv + 1 
    244        titvar(nv) = 'A85S'  ! sea ice extent (85%) in the southern Hemisp.(10^12 km2) 
    245        nv = nv + 1 
    246        titvar(nv) = 'ALEN'  ! leads area in the northern Hemisp.(10^12 km2) 
    247        nv = nv + 1 
    248        titvar(nv) = 'ALES'  ! leads area in the southern Hemisp.(10^12 km2) 
    249        nv = nv + 1 
    250        titvar(nv) = 'VOLN'  ! sea ice volume in the northern Hemisp.(10^3 km3) 
    251        nv = nv + 1 
    252        titvar(nv) = 'VOLS'  ! sea ice volume in the southern Hemisp.(10^3 km3) 
    253        nv = nv + 1 
    254        titvar(nv) = 'VONN'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3) 
    255        nv = nv + 1 
    256        titvar(nv) = 'VONS'  ! snow volume over sea ice in the southern Hemisp.(10^3 km3) 
    257        nv = nv + 1 
    258        titvar(nv) = 'ECGN'  ! mean sea ice velocity in the northern Hemisp.(m/s) 
    259        nv = nv + 1 
    260        titvar(nv) = 'ECGS'  ! mean sea ice velocity in the southern Hemisp.(m/s) 
     210       nv = nv + 1   ;   titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2) 
     211       nv = nv + 1   ;   titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2) 
     212       nv = nv + 1   ;   titvar(nv) = 'A15N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2) 
     213       nv = nv + 1   ;   titvar(nv) = 'A15S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2) 
     214       nv = nv + 1   ;   titvar(nv) = 'A85N'  ! sea ice extent (85%) in the northern Hemisp.(10^12 km2) 
     215       nv = nv + 1   ;   titvar(nv) = 'A85S'  ! sea ice extent (85%) in the southern Hemisp.(10^12 km2) 
     216       nv = nv + 1   ;   titvar(nv) = 'ALEN'  ! leads area in the northern Hemisp.(10^12 km2) 
     217       nv = nv + 1   ;   titvar(nv) = 'ALES'  ! leads area in the southern Hemisp.(10^12 km2) 
     218       nv = nv + 1   ;   titvar(nv) = 'VOLN'  ! sea ice volume in the northern Hemisp.(10^3 km3) 
     219       nv = nv + 1   ;   titvar(nv) = 'VOLS'  ! sea ice volume in the southern Hemisp.(10^3 km3) 
     220       nv = nv + 1   ;   titvar(nv) = 'VONN'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3) 
     221       nv = nv + 1   ;   titvar(nv) = 'VONS'  ! snow volume over sea ice in the southern Hemisp.(10^3 km3) 
     222       nv = nv + 1   ;   titvar(nv) = 'ECGN'  ! mean sea ice velocity in the northern Hemisp.(m/s) 
     223       nv = nv + 1   ;   titvar(nv) = 'ECGS'  ! mean sea ice velocity in the southern Hemisp.(m/s) 
    261224 
    262225       nvinfo = nv 
    263226 
    264227       ! Definition et Ecriture de l'entete : nombre d'enregistrements  
    265        ndeb   = ( nstart - 1 ) / ninfo 
    266        IF( nstart == 1 ) ndeb = -1 
    267  
    268        nferme = ( nstart - 1 + nitrun) / ninfo 
     228       ndeb   = ( nit000 - 1 + nfice - 1 ) / ninfo 
     229       IF( nit000 - 1 + nfice == 1 ) ndeb = -1 
     230 
     231       nferme = ( nitend + nfice - 1 ) / ninfo ! nit000 - 1 + nfice - 1 + nitend - nit000 + 1 
    269232       ntot   = nferme - ndeb 
    270233       ndeb   = ninfo * ( 1 + ndeb ) 
     
    288251 
    289252       !- ecriture de 2 lignes de titre : 
    290        WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                                      & 
     253       WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                 & 
    291254          'Evolution chronologique - Experience '//cexper   & 
    292255          //'   de', ndeb, ' a', nferme, ' pas', ninfo 
     
    3082711000   FORMAT( 3(A20),4(1x,I6) ) 
    3092721111   FORMAT( 3(F7.1,1X,F7.3,1X),I3,A )   
    310  
     273      ! 
    311274    END SUBROUTINE lim_dia_init 
    312275 
  • trunk/NEMO/LIM_SRC/limdmp.F90

    r477 r508  
    44   !!  Ice model : restoring Ice thickness and Fraction leads 
    55   !!====================================================================== 
    6 #if defined key_ice_lim && defined key_tradmp 
     6   !! History :   2.0  !  04-04 (S. Theetten) Original code 
    77   !!---------------------------------------------------------------------- 
    8    !!   'key_ice_lim' :                                   LIM sea-ice model 
     8#if defined key_ice_lim   &&   defined key_tradmp 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_ice_lim'  AND                                LIM sea-ice model 
     11   !!   'key_tradmp'                                                Damping 
     12   !!---------------------------------------------------------------------- 
    913   !!---------------------------------------------------------------------- 
    1014   !!   lim_dmp      : ice model damping 
    1115   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1316   USE in_out_manager  ! I/O manager 
     17   USE phycst          ! physical constants 
    1418   USE ice 
    1519   USE ice_oce 
     
    1822   USE oce 
    1923   USE daymod          ! calendar 
     24   USE iom 
    2025    
    2126   IMPLICIT NONE 
    2227   PRIVATE 
    2328 
    24    !! * Routine accessibility 
    25    PUBLIC lim_dmp     ! called by ice_step 
     29   PUBLIC   lim_dmp     ! called by ice_step 
    2630    
    27    !! * Shared module variables 
    28    CHARACTER (len=38) ::   & 
    29       cl_icedata = 'ice_damping_ATL4.nc' 
    30    INTEGER ::   & 
    31         nice1      ,   &  ! first record used 
    32         nice2             ! second record used 
    33     
    34     REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    35          hicif_data ,   & ! ice thickness data at two consecutive times 
    36          frld_data        ! fraction lead data at two consecutive times 
    37  
    38     REAL(wp), DIMENSION(jpi,jpj) ::   & 
    39          hicif_dta ,   &  ! ice thickness at a given time 
    40          frld_dta         ! fraction lead at a given time 
     31   INTEGER                        ::   nice1, nice2,  &  ! first and second record used 
     32      &                                inumice_dmp       ! logical unit for ice variables (damping) 
     33   REAL(wp), DIMENSION(jpi,jpj)   ::   hicif_dta  ,   &  ! ice thickness at a given time 
     34      &                                frld_dta          ! fraction lead at a given time 
     35   REAL(wp), DIMENSION(jpi,jpj,2) ::   hicif_data ,   &  ! ice thickness data at two consecutive times 
     36      &                                frld_data         ! fraction lead data at two consecutive times 
    4137 
    4238   !! * Substitution 
    4339#  include "vectopt_loop_substitute.h90" 
    4440   !!---------------------------------------------------------------------- 
    45    !!   LIM 2.0 , UCL-LOCEAN-IPSL  (2005) 
     41   !!   LIM 2.0 , UCL-LOCEAN-IPSL  (2006) 
    4642   !! $Header$ 
    47    !! This software is governed by the CeCILL licence see !modipsl/doc/NEMO_CeCILL.txt 
     43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4844   !!---------------------------------------------------------------------- 
    4945 
     
    5854      !! 
    5955      !! ** method  : the key_tradmp must be used to compute resto(:,:) coef. 
    60       !!      
    61       !! ** action : 
    62       !! 
    63       !! History : 
    64       !! 
    65       !!   2.0  !  04-04 (S. Theetten) Original 
    6656      !!--------------------------------------------------------------------- 
    67       !! * Arguments 
    68       INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    69  
    70       !! * Local Variables 
    71       INTEGER  ::   ji, jj         ! dummy loop indices 
     57      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
     58      ! 
     59      INTEGER             ::   ji, jj         ! dummy loop indices 
    7260      !!--------------------------------------------------------------------- 
    73      
    74       CALL dta_lim(kt) 
     61      ! 
     62      CALL dta_lim( kt ) 
    7563 
    7664      DO jj = 2, jpjm1 
    7765         DO ji = fs_2, fs_jpim1   ! vector opt. 
    78  
    79             hicif(ji,jj) = hicif(ji,jj) - rdt_ice * resto(ji,jj,1) * ( hicif(ji,jj) -  hicif_dta(ji,jj)) 
    80             frld(ji,jj)  = frld(ji,jj)  - rdt_ice * resto(ji,jj,1) * ( frld(ji,jj)  - frld_dta(ji,jj))   
    81  
    82          ENDDO 
    83       ENDDO 
    84  
     66            hicif(ji,jj) = hicif(ji,jj) - rdt_ice * resto(ji,jj,1) * ( hicif(ji,jj) - hicif_dta(ji,jj) ) 
     67            frld(ji,jj)  = frld (ji,jj) - rdt_ice * resto(ji,jj,1) * ( frld(ji,jj)  - frld_dta (ji,jj) )   
     68         END DO 
     69      END DO 
     70      ! 
    8571   END SUBROUTINE lim_dmp 
    86  
    8772 
    8873 
     
    10186      !!      two monthly values. 
    10287      !!       
    103       !! 
    10488      !! ** Action  :   define hicif_dta and frld_dta arrays at time-step kt 
    105       !! 
    106       !! History : 
    107       !!   2.0   !   04-04 (S. Theetten) Original 
    10889      !!---------------------------------------------------------------------- 
    109       !! * Modules used 
    110       USE ioipsl 
    111  
    112       !! * Arguments 
    113       INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    114  
    115       !! * Local declarations 
    116       INTEGER, PARAMETER ::   jpmois = 12       ! number of month 
    117       
    118       INTEGER ::   & 
    119          imois, iman, itime ,    &  ! temporary integers 
    120          i15, ipi, ipj, ipk         !    "          " 
    121  
    122       INTEGER, DIMENSION(jpmois) ::   istep 
    123       REAL(wp) ::   zxy, zdate0, zdt 
    124       REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat 
    125       REAL(wp), DIMENSION(jpk) ::   zlev 
     90      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
     91      ! 
     92      INTEGER  ::   imois, iman, i15          ! temporary integers 
     93      REAL(wp) ::   zxy 
    12694      !!---------------------------------------------------------------------- 
    12795 
    12896      ! 0. Initialization 
    12997      ! ----------------- 
    130       iman  = jpmois 
     98      iman  = INT( raamo ) 
     99!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    131100      i15   = nday / 16 
    132101      imois = nmonth + i15 - 1 
    133       IF( imois == 0 )   imois = iman 
    134  
    135       itime = jpmois 
    136       ipi=jpiglo 
    137       ipj=jpjglo 
    138       ipk=1 
    139       zdt=rdt 
    140  
    141       ! 1. First call kt=nit000 
     102      IF( imois == 0 ) imois = iman 
     103       
     104      ! 1. First call kt=nit000: Initialization and Open 
    142105      ! ----------------------- 
    143  
    144106      IF( kt == nit000 ) THEN 
    145107         nice1 = 0 
     
    149111         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT' 
    150112         IF(lwp) WRITE(numout,*) 
    151           
    152113         ! open file 
    153           
    154          CALL flinopen( TRIM(cl_icedata), mig(1), nlci , mjg(1),  nlcj, .FALSE.,  & 
    155             &           ipi, ipj, ipk, zlon, zlat, zlev, itime, istep, zdate0, zdt, numice_dmp ) 
    156  
    157           ! title, dimensions and tests 
    158          IF( itime /= jpmois ) THEN 
    159             IF(lwp) THEN 
    160                WRITE(numout,*) 
    161                WRITE(numout,*) 'problem with time coordinates' 
    162                WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
    163             ENDIF 
    164             STOP 'dta_lim' 
    165          ENDIF 
    166          IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN 
    167             IF(lwp) THEN 
    168                WRITE(numout,*) 
    169                WRITE(numout,*) 'problem with dimensions' 
    170                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    171                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    172             ENDIF 
    173             STOP 'dta_lim' 
    174          ENDIF 
    175          IF(lwp) WRITE(numout,*) itime,istep,zdate0,zdt,numice_dmp 
    176  
     114         CALL iom_open( 'ice_damping_ATL4.nc', inumice_dmp ) 
    177115      ENDIF 
    178116 
    179117 
    180118      ! 2. Read monthly file 
    181       ! ------------------- 
    182  
     119      ! -------------------- 
    183120      IF( ( kt == nit000 ) .OR. imois /= nice1 ) THEN 
    184  
     121         ! 
    185122         ! Calendar computation 
    186           
    187123         nice1 = imois        ! first file record used  
    188124         nice2 = nice1 + 1    ! last  file record used 
    189125         nice1 = MOD( nice1, iman ) 
     126         nice2 = MOD( nice2, iman ) 
    190127         IF( nice1 == 0 )   nice1 = iman 
    191          nice2 = MOD( nice2, iman ) 
    192128         IF( nice2 == 0 )   nice2 = iman 
    193129         IF(lwp) WRITE(numout,*) 'first record file used nice1 ', nice1 
     
    195131          
    196132         ! Read monthly ice thickness Levitus  
     133         CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,1), nice1 )  
     134         CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,2), nice2 )  
    197135          
    198          CALL flinget( numice_dmp, 'iicethic', jpidta, jpjdta, jpk,  & 
    199             &          jpmois, nice1, nice1, mig(1), nlci, mjg(1), nlcj, hicif_data(1:nlci,1:nlcj,1) ) 
    200          CALL flinget( numice_dmp, 'iicethic', jpidta, jpjdta, jpk,  & 
    201             &          jpmois, nice2, nice2, mig(1), nlci, mjg(1), nlcj, hicif_data(1:nlci,1:nlcj,2) ) 
    202           
    203          IF(lwp) WRITE(numout,*) 
    204          IF(lwp) WRITE(numout,*) ' read ice thickness ok' 
    205          IF(lwp) WRITE(numout,*) 
    206  
    207136         ! Read monthly ice thickness Levitus  
    208           
    209          CALL flinget( numice_dmp, 'ileadfra', jpidta, jpjdta, jpk,  & 
    210             &          jpmois, nice1, nice1, mig(1), nlci, mjg(1), nlcj, frld_data(1:nlci,1:nlcj,1) ) 
    211          CALL flinget( numice_dmp, 'ileadfra', jpidta, jpjdta, jpk,  & 
    212             &          jpmois, nice2, nice2, mig(1), nlci, mjg(1), nlcj, frld_data(1:nlci,1:nlcj,2) ) 
     137         CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,1), nice1 )  
     138         CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,2), nice2 )  
    213139          
    214140         ! The fraction lead read in the file is in fact the  
     
    216142         frld_data = 1 - frld_data           
    217143          
    218          IF(lwp) WRITE(numout,*) 
    219          IF(lwp) WRITE(numout,*) ' read fraction lead ok' 
    220          IF(lwp) WRITE(numout,*) 
    221  
    222  
    223144         IF(lwp) THEN 
     145            WRITE(numout,*) 
    224146            WRITE(numout,*) ' Ice thickness month ', nice1,' and ', nice2 
    225147            WRITE(numout,*) 
     
    235157         ! 2. At every time step compute ice thickness and fraction lead data 
    236158         ! ------------------------------------------------------------------ 
    237           
    238159         zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    239160         hicif_dta(:,:) = (1.-zxy) * hicif_data(:,:,1) + zxy * hicif_data(:,:,2) 
     
    241162 
    242163      ENDIF 
    243  
    244  
     164       
     165      IF( kt == nitend )   CALL iom_close( inumice_dmp ) 
     166      ! 
    245167   END SUBROUTINE dta_lim 
    246168 
     
    250172   !!---------------------------------------------------------------------- 
    251173CONTAINS 
    252    SUBROUTINE lim_dmp(kt)        ! Dummy routine 
     174   SUBROUTINE lim_dmp( kt )        ! Dummy routine 
    253175      WRITE(*,*) 'lim_dmp: You should not see this print! error? ', kt 
    254176   END SUBROUTINE lim_dmp 
     
    256178 
    257179   !!====================================================================== 
    258  
    259180END MODULE limdmp 
  • trunk/NEMO/LIM_SRC/limdyn.F90

    r288 r508  
    4242CONTAINS 
    4343 
    44    SUBROUTINE lim_dyn 
     44   SUBROUTINE lim_dyn( kt ) 
    4545      !!------------------------------------------------------------------- 
    4646      !!               ***  ROUTINE lim_dyn  *** 
     
    5858      !!   2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp 
    5959      !!--------------------------------------------------------------------- 
    60       !! * Loal variables 
     60      INTEGER, INTENT(in) ::   kt     ! number of iteration 
     61 
    6162      INTEGER ::   ji, jj             ! dummy loop indices 
    6263      INTEGER ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
     
    7374      !!--------------------------------------------------------------------- 
    7475 
    75       IF( numit == nstart  )   CALL lim_dyn_init   ! Initialization (first time-step only) 
     76      IF( kt == nit000  )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    7677       
    7778      IF ( ln_limdyn ) THEN 
  • trunk/NEMO/LIM_SRC/limistate.F90

    r474 r508  
    44   !!              Initialisation of diagnostics ice variables 
    55   !!====================================================================== 
     6   !! History :   2.0  !  01-04  (C. Ethe, G. Madec)  Original code 
     7   !!                  !  04-04  (S. Theetten) initialization from a file 
     8   !!                  !  06-07  (S. Masson)  IOM to read the restart 
     9   !!-------------------------------------------------------------------- 
    610#if defined key_ice_lim 
    711   !!---------------------------------------------------------------------- 
    812   !!   'key_ice_lim' :                                   LIM sea-ice model 
     13   !!---------------------------------------------------------------------- 
    914   !!---------------------------------------------------------------------- 
    1015   !!   lim_istate      :  Initialisation of diagnostics ice variables 
    1116   !!   lim_istate_init :  initialization of ice state and namelist read 
    1217   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1418   USE phycst 
    1519   USE ocfzpt 
    16    USE oce             ! dynamics and tracers variables 
    17    USE dom_oce 
     20   USE oce             ! dynamics and tracers variables      !!gm used??? 
     21   USE dom_oce                                                     !!gm used??? 
    1822   USE par_ice         ! ice parameters 
    1923   USE ice_oce         ! ice variables 
     24   USE dom_ice 
     25   USE ice             ! ??? 
     26   USE lbclnk 
     27   USE ice 
     28   USE iom 
    2029   USE in_out_manager 
    21    USE dom_ice 
    22    USE ice 
    23    USE lbclnk 
    2430 
    2531   IMPLICIT NONE 
    2632   PRIVATE 
    2733 
    28    !! * Accessibility 
    2934   PUBLIC lim_istate      ! routine called by lim_init.F90 
    3035 
    31    !! * Module variables 
    32    REAL(wp) ::           & !!! ** init namelist (namiceini) ** 
     36   REAL(wp) ::           &  !!! ** init namelist (namiceini) ** 
    3337      ttest  = 2.0  ,    &  ! threshold water temperature for initial sea ice 
    3438      hninn  = 0.5  ,    &  ! initial snow thickness in the north 
     
    4347      zone    = 1.e0 
    4448   !!---------------------------------------------------------------------- 
    45    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     49   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
    4650   !! $Header$  
    47    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     51   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4852   !!---------------------------------------------------------------------- 
    4953 
     
    5862      !! ** Method  :   restart from a state defined in a binary file 
    5963      !!                or from arbitrary sea-ice conditions 
    60       !! 
    61       !! History : 
    62       !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code 
    63       !!        !  04-04  (S. Theetten) initialization from a file 
    6464      !!-------------------------------------------------------------------- 
    65       !! * Local variables 
    66       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    67       REAL(wp) ::   zidto,    &  ! temporary scalar 
    68          zs0, ztf, zbin 
    69       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    70          ztn 
     65      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
     66      REAL(wp) ::   zidto, zs0, ztf, zbin     ! temporary scalar 
     67      REAL(wp), DIMENSION(jpi,jpj) ::   ztn   ! workspace 
    7168      !-------------------------------------------------------------------- 
    7269 
    73   
    74       CALL lim_istate_init     !  reading the initials parameters of the ice 
     70       CALL lim_istate_init     !  reading the initials parameters of the ice 
    7571 
    7672      !-- Initialisation of sst,sss,u,v do i=1,jpi 
     
    203199      CALL lbc_lnk( qstoif , 'T', 1. ) 
    204200      CALL lbc_lnk( sss_io , 'T', 1. ) 
    205  
     201      ! 
    206202   END SUBROUTINE lim_istate 
    207203 
     
    220216      !! 
    221217      !! ** input   :   Namelist namiceini 
    222       !! 
    223       !! history 
    224       !!  8.5  ! 03-08 (C. Ethe) original code 
    225       !!  9.0  ! 04-04 (S. Theetten) read a file 
    226       !!------------------------------------------------------------------- 
    227       !! * Modules used 
    228       USE ice 
    229       USE ioipsl 
     218      !!------------------------------------------------------------------- 
     219      INTEGER :: inum_ice 
    230220 
    231221      NAMELIST/namiceini/ ln_limini, ln_limdmp, ttest, hninn, hginn, alinn, & 
    232222         &                hnins, hgins, alins 
    233223      !!------------------------------------------------------------------- 
    234       !! local declaration 
    235       INTEGER, PARAMETER ::   jpmois=1 
    236        
    237       INTEGER ::                   & 
    238            itime, ipi, ipj, ipk  , & ! temporary integers 
    239            inum_ice 
    240        
    241       INTEGER ::  istep(jpmois) 
    242        
    243       REAL(wp) ::   zdate0, zdt 
    244       REAL(wp), DIMENSION(jpi,jpj) ::   zlon, zlat 
    245       REAL(wp), DIMENSION(3) ::   zlev 
    246        
    247       CHARACTER (len=32) :: cl_icedata 
    248        
    249       LOGICAL :: llbon 
    250       !!------------------------------------------------------------------- 
    251224       
    252225      ! Read Namelist namiceini  
    253  
    254226      REWIND ( numnam_ice ) 
    255227      READ   ( numnam_ice , namiceini ) 
     
    272244      IF( ln_limini ) THEN                      ! Ice initialization using input file 
    273245 
    274          cl_icedata = 'Ice_initialization.nc' 
    275          INQUIRE( FILE=cl_icedata, EXIST=llbon ) 
    276          IF( llbon ) THEN 
     246         CALL iom_open( 'Ice_initialization.nc', inum_ice ) 
     247 
     248         IF( inum_ice > 0 ) THEN 
    277249            IF(lwp) THEN 
    278250               WRITE(numout,*) ' ' 
    279                WRITE(numout,*) 'lim_istate_init : ice state initialization with : ',cl_icedata 
     251               WRITE(numout,*) 'lim_istate_init : ice state initialization with : Ice_initialization.nc' 
    280252               WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    281253               WRITE(numout,*) '         Ice state initialization using input file    ln_limini  = ', ln_limini 
     
    284256            ENDIF 
    285257             
    286             itime = 1 
    287             ipi=jpiglo 
    288             ipj=jpjglo 
    289             ipk=1 
    290             zdt=rdt 
     258            CALL iom_get( inum_ice, jpdom_data, 'sst'  , sst_ini(:,:) )         
     259            CALL iom_get( inum_ice, jpdom_data, 'sss'  , sss_ini(:,:) )        
     260            CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif  (:,:) )       
     261            CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif  (:,:) )       
     262            CALL iom_get( inum_ice, jpdom_data, 'frld' , frld   (:,:) )      
     263            CALL iom_get( inum_ice, jpdom_data, 'ts'   , sist   (:,:) ) 
     264            CALL iom_get( inum_ice, jpdom_unknown, 'tbif', tbif(:,:,:),   & 
     265                 &        kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,jplayersp1 /) ) 
     266 
     267            CALL iom_close( inum_ice) 
    291268             
    292             CALL flinopen( TRIM(cl_icedata), mig(1), nlci, mjg(1), nlcj, .FALSE., & 
    293                &           ipi, ipj, ipk, zlon, zlat, zlev, itime, istep, zdate0, zdt, inum_ice ) 
    294              
    295             CALL flinget( inum_ice, 'sst', jpidta, jpjdta, 1,  & 
    296                &          jpmois, 1, 0, mig(1), nlci, mjg(1), nlcj, sst_ini(1:nlci,1:nlcj) ) 
    297              
    298             CALL flinget( inum_ice, 'sss', jpidta, jpjdta, 1,  & 
    299                &          jpmois, 1, 0, mig(1), nlci, mjg(1), nlcj, sss_ini(1:nlci,1:nlcj) ) 
    300              
    301             CALL flinget( inum_ice, 'hicif', jpidta, jpjdta, 1,  & 
    302                &          jpmois, 1, 0, mig(1), nlci, mjg(1), nlcj, hicif(1:nlci,1:nlcj) ) 
    303              
    304             CALL flinget( inum_ice, 'hsnif', jpidta, jpjdta, 1,  & 
    305                &          jpmois, 1, 0, mig(1), nlci, mjg(1), nlcj, hsnif(1:nlci,1:nlcj) ) 
    306              
    307             CALL flinget( inum_ice, 'frld', jpidta, jpjdta, 1,  & 
    308                &          jpmois, 1, 0, mig(1), nlci, mjg(1), nlcj, frld(1:nlci,1:nlcj) ) 
    309              
    310             CALL flinget( inum_ice, 'ts', jpidta, jpjdta, 1,  & 
    311                &          jpmois, 1, 0, mig(1), nlci, mjg(1), nlcj, sist(1:nlci,1:nlcj) ) 
    312              
    313             CALL flinclo( inum_ice) 
    314              
    315             itime = 1 
    316             ipi=jpiglo 
    317             ipj=jpjglo 
    318             ipk=jplayersp1 
    319              
    320             CALL flinopen( TRIM(cl_icedata), mig(1), nlci, mjg(1), nlcj, .FALSE.,  & 
    321                &           ipi, ipj, ipk, zlon, zlat, zlev, itime, istep, zdate0, zdt, inum_ice ) 
    322              
    323             CALL flinget( inum_ice, 'tbif', jpidta, jpjdta, ipk,  & 
    324                &          jpmois, 1, 0, mig(1), nlci, mjg(1), nlcj, tbif(1:nlci,1:nlcj,1:ipk) ) 
    325              
    326             CALL flinclo( inum_ice) 
    327              
    328          ELSE 
    329             WRITE(ctmp1,*) '            ',cl_icedata, ' not found !' 
    330             CALL ctl_stop( ctmp1 ) 
    331269         ENDIF 
    332270      ENDIF 
    333  
     271      ! 
    334272   END SUBROUTINE lim_istate_init 
    335273 
  • trunk/NEMO/LIM_SRC/limrst.F90

    r473 r508  
    44   !! Ice restart :  write the ice restart file 
    55   !!====================================================================== 
     6   !! History :  2.0  !  01-04  (C. Ethe, G. Madec)  Original code 
     7   !!                 !  06-07  (S. Masson)  use IOM for restart read/write 
     8   !!---------------------------------------------------------------------- 
    69#if defined key_ice_lim 
    710   !!---------------------------------------------------------------------- 
    811   !!   'key_ice_lim' :                                   LIM sea-ice model 
    912   !!---------------------------------------------------------------------- 
    10    !!   lim_rst_write   : write of the restart file  
    11    !!   lim_rst_read    : read  the restart file  
    12    !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    14    USE in_out_manager 
     13   !!---------------------------------------------------------------------- 
     14   !!   lim_rst_opn   : open ice restart file 
     15   !!   lim_rst_write : write of the ice restart file  
     16   !!   lim_rst_read  : read  the ice restart file  
     17   !!---------------------------------------------------------------------- 
    1518   USE ice 
    16    USE ioipsl 
    1719   USE dom_oce 
    1820   USE ice_oce         ! ice variables 
    1921   USE daymod 
    2022 
     23   USE in_out_manager 
     24   USE iom 
     25   USE restart 
     26 
    2127   IMPLICIT NONE 
    2228   PRIVATE 
    2329 
    24    !! * Accessibility 
    25    PUBLIC lim_rst_write  ! routine called by lim_step.F90 
    26    PUBLIC lim_rst_read   ! routine called by lim_init.F90 
    27  
    28    !!---------------------------------------------------------------------- 
    29    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     30   PUBLIC   lim_rst_opn     ! routine called by ??? module 
     31   PUBLIC   lim_rst_write   ! routine called by ??? module 
     32   PUBLIC   lim_rst_read    ! routine called by ??? module 
     33 
     34   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the oce restart write  
     35   INTEGER, PUBLIC ::   numrir, numriw   !: logical unit for ice restart (read and write) 
     36 
     37   !!---------------------------------------------------------------------- 
     38   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
    3039   !! $Header$  
    31    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3241   !!---------------------------------------------------------------------- 
    3342 
     
    3645# if ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout 
    3746   !!---------------------------------------------------------------------- 
    38    !!   'key_mpp_mpi'     OR 
    39    !!   'key_mpp_shmem' 
    40    !!   'key_dimgout' :                           clipper type restart file 
    41    !!                 :                     can be used in mpp 
     47   !!   'key_mpp_mpi'     OR     'key_mpp_shmem'              MPP computing 
     48   !!   'key_dimgout' :                    Direct access file (DIMG format) 
    4249   !!---------------------------------------------------------------------- 
    4350#  include "limrst_dimg.h90" 
     
    4855   !!---------------------------------------------------------------------- 
    4956 
    50    SUBROUTINE lim_rst_write( niter ) 
     57   SUBROUTINE lim_rst_opn( kt ) 
     58      !!---------------------------------------------------------------------- 
     59      !!                    ***  lim_rst_opn  *** 
     60      !! 
     61      !! ** purpose  :   output of sea-ice variable in a netcdf file 
     62      !!---------------------------------------------------------------------- 
     63      INTEGER, INTENT(in) ::   kt       ! number of iteration 
     64      ! 
     65      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
     66      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     67      !!---------------------------------------------------------------------- 
     68      ! 
     69      IF( kt == nit000 )   lrst_ice = .FALSE. 
     70       
     71      IF    ( kt == nitrst - 2*nfice + 1 .AND. lrst_ice ) THEN 
     72         CALL ctl_stop( 'lim_rst_opn: ice restart frequency must be larger than nfice' ) 
     73         numriw = 0 
     74      ELSEIF( kt == nitrst - 2*nfice + 1 .OR.  nitend - nit000 +1 < 2*nfice ) THEN 
     75         ! beware if model runs less than 2*nfice time step 
     76         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
     77         IF( nitrst > 1.0e9 ) THEN    
     78            WRITE(clkt,*) nitrst 
     79         ELSE 
     80            WRITE(clkt,'(i8.8)') nitrst 
     81         ENDIF 
     82         ! create the file 
     83         IF(lwp) WRITE(numout,*) 
     84         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart_ice" 
     85         IF(lwp) WRITE(numout,*) '             open ice restart.output NetCDF file: '//clname 
     86         CALL iom_open( clname, numriw, ldwrt = .TRUE. ) 
     87         lrst_ice = .TRUE. 
     88      ENDIF 
     89      ! 
     90   END SUBROUTINE lim_rst_opn 
     91 
     92   SUBROUTINE lim_rst_write( kt ) 
    5193      !!---------------------------------------------------------------------- 
    5294      !!                    ***  lim_rst_write  *** 
    5395      !! 
    5496      !! ** purpose  :   output of sea-ice variable in a netcdf file 
    55       !! 
    56       !!---------------------------------------------------------------------- 
    57       ! Arguments 
    58       INTEGER  ::    niter        ! number of iteration 
    59  
    60       !- dummy variables : 
    61       LOGICAL :: & 
    62          llbon 
    63       INTEGER :: & 
    64          ji, jj 
    65       INTEGER :: & 
    66          inumwrs, it0, itime 
    67       REAL(wp), DIMENSION(1) :: & 
    68          zdept 
    69       REAL(wp), DIMENSION(2) :: & 
    70          zinfo 
    71       REAL(wp),DIMENSION(jpi,jpj,35) :: & 
    72          zmoment 
    73       REAL(wp) :: & 
    74          zsec, zdate0, zdt 
    75  
    76       CHARACTER(len=45)  ::  ccfile 
    77  
    78       ccfile = 'restart_ice_out.nc' 
    79  
    80 #if defined key_agrif 
    81       if ( .NOT. Agrif_Root() ) then 
    82          ccfile= TRIM(Agrif_CFixed())//'_'//TRIM(ccfile) 
    83       endif 
    84 #endif 
    85  
    86       inumwrs  = 61 
    87       INQUIRE ( FILE = ccfile, EXIST = llbon ) 
    88       IF( llbon ) THEN 
    89          OPEN ( UNIT = inumwrs , FILE = ccfile, STATUS = 'old' ) 
    90          CLOSE( inumwrs , STATUS = 'delete' ) 
    91       ENDIF 
    92  
    93  
    94       it0      = niter 
    95       zinfo(1) = FLOAT( nfice  )  ! coupling frequency OPA ICELLN  nfice 
    96       zinfo(2) = FLOAT( it0   )   ! iteration number 
    97  
    98       zsec     = 0.e0 
    99       itime    = 0 
    100       zdept(1) = 0.e0 
    101       zdt      = rdt_ice * nstock 
    102  
    103       ! Write in inumwrs 
    104  
    105       DO jj = 1, jpj              ! 3D array: 10 time faster than 35 restput 
    106          DO ji = 1, jpi 
    107             zmoment(ji,jj,1)  = sxice(ji,jj) 
    108             zmoment(ji,jj,2)  = syice(ji,jj) 
    109             zmoment(ji,jj,3)  = sxxice(ji,jj) 
    110             zmoment(ji,jj,4)  = syyice(ji,jj) 
    111             zmoment(ji,jj,5)  = sxyice(ji,jj) 
    112             zmoment(ji,jj,6)  = sxsn(ji,jj) 
    113             zmoment(ji,jj,7)  = sysn(ji,jj) 
    114             zmoment(ji,jj,8)  = sxxsn(ji,jj) 
    115             zmoment(ji,jj,9)  = syysn(ji,jj) 
    116             zmoment(ji,jj,10) = sxysn(ji,jj) 
    117             zmoment(ji,jj,11) = sxa(ji,jj) 
    118             zmoment(ji,jj,12) = sya(ji,jj) 
    119             zmoment(ji,jj,13) = sxxa(ji,jj) 
    120             zmoment(ji,jj,14) = syya(ji,jj) 
    121             zmoment(ji,jj,15) = sxya(ji,jj) 
    122             zmoment(ji,jj,16) = sxc0(ji,jj) 
    123             zmoment(ji,jj,17) = syc0(ji,jj) 
    124             zmoment(ji,jj,18) = sxxc0(ji,jj) 
    125             zmoment(ji,jj,19) = syyc0(ji,jj) 
    126             zmoment(ji,jj,20) = sxyc0(ji,jj) 
    127             zmoment(ji,jj,21) = sxc1(ji,jj) 
    128             zmoment(ji,jj,22) = syc1(ji,jj) 
    129             zmoment(ji,jj,23) = sxxc1(ji,jj) 
    130             zmoment(ji,jj,24) = syyc1(ji,jj) 
    131             zmoment(ji,jj,25) = sxyc1(ji,jj) 
    132             zmoment(ji,jj,26) = sxc2(ji,jj) 
    133             zmoment(ji,jj,27) = syc2(ji,jj) 
    134             zmoment(ji,jj,28) = sxxc2(ji,jj) 
    135             zmoment(ji,jj,29) = syyc2(ji,jj) 
    136             zmoment(ji,jj,30) = sxyc2(ji,jj) 
    137             zmoment(ji,jj,31) = sxst(ji,jj) 
    138             zmoment(ji,jj,32) = syst(ji,jj) 
    139             zmoment(ji,jj,33) = sxxst(ji,jj) 
    140             zmoment(ji,jj,34) = syyst(ji,jj) 
    141             zmoment(ji,jj,35) = sxyst(ji,jj) 
    142          END DO 
    143       END DO 
    144  
    145       CALL ymds2ju( nyear, nmonth, nday, zsec, zdate0 ) 
    146       CALL restini( 'NONE', jpi, jpj, glamt, gphit, 1 , zdept, ccfile, itime, zdate0, zdt, & 
    147          &         inumwrs, domain_id=nidom ) 
    148        
    149       CALL restput( inumwrs, 'info'   ,   1,   1, 2 , 0, zinfo   )  ! restart informations 
    150         
    151       CALL restput( inumwrs, 'hicif'  , jpi, jpj, 1 , 0, hicif   )  ! prognostic variables  
    152       CALL restput( inumwrs, 'hsnif'  , jpi, jpj, 1 , 0, hsnif   ) 
    153       CALL restput( inumwrs, 'frld'   , jpi, jpj, 1 , 0, frld    ) 
    154       CALL restput( inumwrs, 'sist'   , jpi, jpj, 1 , 0, sist    ) 
     97      !!---------------------------------------------------------------------- 
     98      INTEGER, INTENT(in) ::   kt     ! number of iteration 
     99      !! 
     100      INTEGER ::   iter     ! kt + nfice -1 
     101      !!---------------------------------------------------------------------- 
     102 
     103      iter = kt + nfice -1 
     104 
     105      IF( iter == nitrst ) THEN 
     106         IF(lwp) WRITE(numout,*) 
     107         IF(lwp) WRITE(numout,*) 'lim_rst_write : write ice restart.output NetCDF file  kt =', kt 
     108         IF(lwp) WRITE(numout,*) '~~~~~~~'          
     109      ENDIF 
     110 
     111      ! Write in numriw (if iter == nitrst) 
     112      ! ------------------  
     113      !                                                                     ! calendar control 
     114      CALL iom_rstput( iter, nitrst, numriw, 'nfice' , REAL( nfice, wp) )      ! time-step  
     115      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter, wp) )      ! date 
     116       
     117      CALL iom_rstput( iter, nitrst, numriw, 'hicif' , hicif (:,:)   )      ! prognostic variables  
     118      CALL iom_rstput( iter, nitrst, numriw, 'hsnif' , hsnif (:,:)   ) 
     119      CALL iom_rstput( iter, nitrst, numriw, 'frld'  , frld  (:,:)   ) 
     120      CALL iom_rstput( iter, nitrst, numriw, 'sist'  , sist  (:,:)   ) 
    155121# if defined key_coupled 
    156       CALL restput( inumwrs, 'albege' , jpi, jpj, 1 , 0, albege ) 
     122      CALL iom_rstput( iter, nitrst, numriw, 'albege', albege(:,:) ) 
    157123# endif 
    158       CALL restput( inumwrs, 'tbif'   , jpi, jpj, 3 , 0, tbif    ) 
    159       CALL restput( inumwrs, 'u_ice'  , jpi, jpj, 1 , 0, u_ice   ) 
    160       CALL restput( inumwrs, 'v_ice'  , jpi, jpj, 1 , 0, v_ice   ) 
    161       CALL restput( inumwrs, 'gtaux'  , jpi, jpj, 1 , 0, gtaux  ) 
    162       CALL restput( inumwrs, 'gtauy'  , jpi, jpj, 1 , 0, gtauy  ) 
    163       CALL restput( inumwrs, 'qstoif' , jpi, jpj, 1 , 0, qstoif  ) 
    164       CALL restput( inumwrs, 'fsbbq'  , jpi, jpj, 1 , 0, fsbbq   ) 
    165       CALL restput( inumwrs, 'moment' , jpi, jpj, 35, 0, zmoment ) 
    166  
    167        
    168       CALL restclo( inumwrs ) 
    169  
     124      CALL iom_rstput( iter, nitrst, numriw, 'tbif1' , tbif  (:,:,1) ) 
     125      CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif  (:,:,2) ) 
     126      CALL iom_rstput( iter, nitrst, numriw, 'tbif3' , tbif  (:,:,3) ) 
     127      CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice (:,:)   ) 
     128      CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice (:,:)   ) 
     129      CALL iom_rstput( iter, nitrst, numriw, 'gtaux' , gtaux (:,:)   ) 
     130      CALL iom_rstput( iter, nitrst, numriw, 'gtauy' , gtauy (:,:)   ) 
     131      CALL iom_rstput( iter, nitrst, numriw, 'qstoif', qstoif(:,:)   ) 
     132      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq (:,:)   ) 
     133      CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice (:,:)   ) 
     134      CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice (:,:)   ) 
     135      CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice(:,:)   ) 
     136      CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice(:,:)   ) 
     137      CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice(:,:)   ) 
     138      CALL iom_rstput( iter, nitrst, numriw, 'sxsn'  , sxsn  (:,:)   ) 
     139      CALL iom_rstput( iter, nitrst, numriw, 'sysn'  , sysn  (:,:)   ) 
     140      CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn (:,:)   ) 
     141      CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn (:,:)   ) 
     142      CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn (:,:)   ) 
     143      CALL iom_rstput( iter, nitrst, numriw, 'sxa'   , sxa   (:,:)   ) 
     144      CALL iom_rstput( iter, nitrst, numriw, 'sya'   , sya   (:,:)   ) 
     145      CALL iom_rstput( iter, nitrst, numriw, 'sxxa'  , sxxa  (:,:)   ) 
     146      CALL iom_rstput( iter, nitrst, numriw, 'syya'  , syya  (:,:)   ) 
     147      CALL iom_rstput( iter, nitrst, numriw, 'sxya'  , sxya  (:,:)   ) 
     148      CALL iom_rstput( iter, nitrst, numriw, 'sxc0'  , sxc0  (:,:)   ) 
     149      CALL iom_rstput( iter, nitrst, numriw, 'syc0'  , syc0  (:,:)   ) 
     150      CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0 (:,:)   ) 
     151      CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0 (:,:)   ) 
     152      CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0 (:,:)   ) 
     153      CALL iom_rstput( iter, nitrst, numriw, 'sxc1'  , sxc1  (:,:)   ) 
     154      CALL iom_rstput( iter, nitrst, numriw, 'syc1'  , syc1  (:,:)   ) 
     155      CALL iom_rstput( iter, nitrst, numriw, 'sxxc1' , sxxc1 (:,:)   ) 
     156      CALL iom_rstput( iter, nitrst, numriw, 'syyc1' , syyc1 (:,:)   ) 
     157      CALL iom_rstput( iter, nitrst, numriw, 'sxyc1' , sxyc1 (:,:)   ) 
     158      CALL iom_rstput( iter, nitrst, numriw, 'sxc2'  , sxc2  (:,:)   ) 
     159      CALL iom_rstput( iter, nitrst, numriw, 'syc2'  , syc2  (:,:)   ) 
     160      CALL iom_rstput( iter, nitrst, numriw, 'sxxc2' , sxxc2 (:,:)   ) 
     161      CALL iom_rstput( iter, nitrst, numriw, 'syyc2' , syyc2 (:,:)   ) 
     162      CALL iom_rstput( iter, nitrst, numriw, 'sxyc2' , sxyc2 (:,:)   ) 
     163      CALL iom_rstput( iter, nitrst, numriw, 'sxst'  , sxst  (:,:)   ) 
     164      CALL iom_rstput( iter, nitrst, numriw, 'syst'  , syst  (:,:)   ) 
     165      CALL iom_rstput( iter, nitrst, numriw, 'sxxst' , sxxst (:,:)   ) 
     166      CALL iom_rstput( iter, nitrst, numriw, 'syyst' , syyst (:,:)   ) 
     167      CALL iom_rstput( iter, nitrst, numriw, 'sxyst' , sxyst (:,:)   ) 
     168       
     169      IF( iter == nitrst ) THEN 
     170         CALL iom_close( numriw )                         ! close the restart file 
     171         lrst_ice = .FALSE. 
     172      ENDIF 
     173      ! 
    170174   END SUBROUTINE lim_rst_write 
    171175 
    172176 
    173    SUBROUTINE lim_rst_read( niter ) 
    174       !----------------------------------------------------------------------- 
    175       !  restart from a state defined in a binary file 
    176       !----------------------------------------------------------------------- 
    177       !! * Modules used 
    178       USE iom 
    179       ! Arguments 
    180       INTEGER  ::   niter        ! number of iteration 
    181  
    182       !- dummy variables : 
    183       INTEGER :: & 
    184          inum, it1, ifice 
    185       REAL(wp),DIMENSION(jpi,jpj,35) :: & 
    186          zmoment 
    187       REAL(wp),DIMENSION(1, 1, 2) :: & 
    188          zinfo 
    189  
    190       CALL iom_open ( 'restart_ice_in', inum ) 
    191  
    192       CALL iom_get (inum, jpdom_unknown, 'info', zinfo) 
    193       ifice   = INT( zinfo(1, 1, 1) ) ! not used ... 
    194       it1     = INT( zinfo(1, 1, 2) ) 
    195  
    196       IF(lwp) WRITE(numout,*) 'lim_rst_read : READ restart file at time step : ', it1 
     177   SUBROUTINE lim_rst_read 
     178      !!---------------------------------------------------------------------- 
     179      !!                    ***  lim_rst_read  *** 
     180      !! 
     181      !! ** purpose  :   read of sea-ice variable restart in a netcdf file 
     182      !!---------------------------------------------------------------------- 
     183      ! 
     184      REAL(wp) ::   zfice, ziter 
     185      !!---------------------------------------------------------------------- 
     186 
     187      IF(lwp) THEN 
     188         WRITE(numout,*) 
     189         WRITE(numout,*) 'lim_rst_read : read ice NetCDF restart file' 
     190         WRITE(numout,*) '~~~~~~~~' 
     191      ENDIF 
     192 
     193      CALL iom_open ( 'restart_ice_in', numrir ) 
     194 
     195      CALL iom_get( numrir, 'nfice' , zfice ) 
     196      CALL iom_get( numrir, 'kt_ice', ziter )     
     197      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
     198      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
    197199 
    198200      !Control of date 
    199201       
    200       IF( ( nit000 - it1 ) /= 1 .AND. ABS( nrstdt ) == 1 ) & 
    201            CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 for the restart',  & 
    202       &                   '   verify the file or rerun with the value 0 for the',        & 
    203       &                   '   control of time parameter  nrstdt' ) 
    204  
    205       CALL iom_get( inum, jpdom_local, 'hicif' , hicif )     
    206       CALL iom_get( inum, jpdom_local, 'hsnif' , hsnif )     
    207       CALL iom_get( inum, jpdom_local, 'frld'  , frld )     
    208       CALL iom_get( inum, jpdom_local, 'sist'  , sist )     
     202      IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
     203         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  & 
     204         &                   '   verify the file or rerun with the value 0 for the',        & 
     205         &                   '   control of time parameter  nrstdt' ) 
     206      IF( INT(zfice) /= nfice          .AND. ABS( nrstdt ) == 1 )   & 
     207         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nfice in ice restart',  & 
     208         &                   '   verify the file or rerun with the value 0 for the',        & 
     209         &                   '   control of time parameter  nrstdt' ) 
     210 
     211      CALL iom_get( numrir, jpdom_local, 'hicif' , hicif  )     
     212      CALL iom_get( numrir, jpdom_local, 'hsnif' , hsnif  )     
     213      CALL iom_get( numrir, jpdom_local, 'frld'  , frld   )     
     214      CALL iom_get( numrir, jpdom_local, 'sist'  , sist   )     
    209215# if defined key_coupled  
    210       CALL iom_get( inum, jpdom_local, 'albege', albege )     
     216      CALL iom_get( numrir, jpdom_local, 'albege', albege )     
    211217# endif 
    212       CALL iom_get( inum, jpdom_unknown, 'tbif', tbif )     
    213       CALL iom_get( inum, jpdom_local, 'u_ice' , u_ice )     
    214       CALL iom_get( inum, jpdom_local, 'v_ice' , v_ice )     
    215       CALL iom_get( inum, jpdom_local, 'gtaux' , gtaux )     
    216       CALL iom_get( inum, jpdom_local, 'gtauy' , gtauy )     
    217       CALL iom_get( inum, jpdom_local, 'qstoif', qstoif )     
    218       CALL iom_get( inum, jpdom_local, 'fsbbq' , fsbbq )     
    219       CALL iom_get( inum, jpdom_unknown, 'moment', zmoment )     
    220       sxice(:,:)  = zmoment(:,:,1) 
    221       syice(:,:)  = zmoment(:,:,2) 
    222       sxxice(:,:) = zmoment(:,:,3) 
    223       syyice(:,:) = zmoment(:,:,4) 
    224       sxyice(:,:) = zmoment(:,:,5) 
    225       sxsn(:,:)   = zmoment(:,:,6) 
    226       sysn(:,:)   = zmoment(:,:,7) 
    227       sxxsn(:,:)  = zmoment(:,:,8) 
    228       syysn(:,:)  = zmoment(:,:,9) 
    229       sxysn(:,:)  = zmoment(:,:,10) 
    230       sxa(:,:)    = zmoment(:,:,11) 
    231       sya(:,:)    = zmoment(:,:,12) 
    232       sxxa(:,:)   = zmoment(:,:,13) 
    233       syya(:,:)   = zmoment(:,:,14) 
    234       sxya(:,:)   = zmoment(:,:,15) 
    235       sxc0(:,:)   = zmoment(:,:,16) 
    236       syc0(:,:)   = zmoment(:,:,17) 
    237       sxxc0(:,:)  = zmoment(:,:,18) 
    238       syyc0(:,:)  = zmoment(:,:,19) 
    239       sxyc0(:,:)  = zmoment(:,:,20) 
    240       sxc1(:,:)   = zmoment(:,:,21) 
    241       syc1(:,:)   = zmoment(:,:,22) 
    242       sxxc1(:,:)  = zmoment(:,:,23) 
    243       syyc1(:,:)  = zmoment(:,:,24) 
    244       sxyc1(:,:)  = zmoment(:,:,25) 
    245       sxc2(:,:)   = zmoment(:,:,26) 
    246       syc2(:,:)   = zmoment(:,:,27) 
    247       sxxc2(:,:)  = zmoment(:,:,28) 
    248       syyc2(:,:)  = zmoment(:,:,29) 
    249       sxyc2(:,:)  = zmoment(:,:,30) 
    250       sxst(:,:)   = zmoment(:,:,31) 
    251       syst(:,:)   = zmoment(:,:,32) 
    252       sxxst(:,:)  = zmoment(:,:,33) 
    253       syyst(:,:)  = zmoment(:,:,34) 
    254       sxyst(:,:)  = zmoment(:,:,35) 
    255        
    256       CALL iom_close( inum ) 
    257        
    258       niter = it1 
    259  
     218      CALL iom_get( numrir, jpdom_local, 'tbif1' , tbif(:,:,1) )     
     219      CALL iom_get( numrir, jpdom_local, 'tbif2' , tbif(:,:,2) )     
     220      CALL iom_get( numrir, jpdom_local, 'tbif3' , tbif(:,:,3) )     
     221      CALL iom_get( numrir, jpdom_local, 'u_ice' , u_ice  )     
     222      CALL iom_get( numrir, jpdom_local, 'v_ice' , v_ice  )     
     223      CALL iom_get( numrir, jpdom_local, 'gtaux' , gtaux  )     
     224      CALL iom_get( numrir, jpdom_local, 'gtauy' , gtauy  )     
     225      CALL iom_get( numrir, jpdom_local, 'qstoif', qstoif )     
     226      CALL iom_get( numrir, jpdom_local, 'fsbbq' , fsbbq  )     
     227      CALL iom_get( numrir, jpdom_local, 'sxice' , sxice  ) 
     228      CALL iom_get( numrir, jpdom_local, 'syice' , syice  ) 
     229      CALL iom_get( numrir, jpdom_local, 'sxxice', sxxice ) 
     230      CALL iom_get( numrir, jpdom_local, 'syyice', syyice ) 
     231      CALL iom_get( numrir, jpdom_local, 'sxyice', sxyice ) 
     232      CALL iom_get( numrir, jpdom_local, 'sxsn'  , sxsn   ) 
     233      CALL iom_get( numrir, jpdom_local, 'sysn'  , sysn   ) 
     234      CALL iom_get( numrir, jpdom_local, 'sxxsn' , sxxsn  ) 
     235      CALL iom_get( numrir, jpdom_local, 'syysn' , syysn  ) 
     236      CALL iom_get( numrir, jpdom_local, 'sxysn' , sxysn  ) 
     237      CALL iom_get( numrir, jpdom_local, 'sxa'   , sxa    ) 
     238      CALL iom_get( numrir, jpdom_local, 'sya'   , sya    ) 
     239      CALL iom_get( numrir, jpdom_local, 'sxxa'  , sxxa   ) 
     240      CALL iom_get( numrir, jpdom_local, 'syya'  , syya   ) 
     241      CALL iom_get( numrir, jpdom_local, 'sxya'  , sxya   ) 
     242      CALL iom_get( numrir, jpdom_local, 'sxc0'  , sxc0   ) 
     243      CALL iom_get( numrir, jpdom_local, 'syc0'  , syc0   ) 
     244      CALL iom_get( numrir, jpdom_local, 'sxxc0' , sxxc0  ) 
     245      CALL iom_get( numrir, jpdom_local, 'syyc0' , syyc0  ) 
     246      CALL iom_get( numrir, jpdom_local, 'sxyc0' , sxyc0  ) 
     247      CALL iom_get( numrir, jpdom_local, 'sxc1'  , sxc1   ) 
     248      CALL iom_get( numrir, jpdom_local, 'syc1'  , syc1   ) 
     249      CALL iom_get( numrir, jpdom_local, 'sxxc1' , sxxc1  ) 
     250      CALL iom_get( numrir, jpdom_local, 'syyc1' , syyc1  ) 
     251      CALL iom_get( numrir, jpdom_local, 'sxyc1' , sxyc1  ) 
     252      CALL iom_get( numrir, jpdom_local, 'sxc2'  , sxc2   ) 
     253      CALL iom_get( numrir, jpdom_local, 'syc2'  , syc2   ) 
     254      CALL iom_get( numrir, jpdom_local, 'sxxc2' , sxxc2  ) 
     255      CALL iom_get( numrir, jpdom_local, 'syyc2' , syyc2  ) 
     256      CALL iom_get( numrir, jpdom_local, 'sxyc2' , sxyc2  ) 
     257      CALL iom_get( numrir, jpdom_local, 'sxst'  , sxst   ) 
     258      CALL iom_get( numrir, jpdom_local, 'syst'  , syst   ) 
     259      CALL iom_get( numrir, jpdom_local, 'sxxst' , sxxst  ) 
     260      CALL iom_get( numrir, jpdom_local, 'syyst' , syyst  ) 
     261      CALL iom_get( numrir, jpdom_local, 'sxyst' , sxyst  ) 
     262       
     263      CALL iom_close( numrir ) 
     264      ! 
    260265   END SUBROUTINE lim_rst_read 
    261266 
     
    266271   !!   Default option :       Empty module            NO LIM sea-ice model 
    267272   !!---------------------------------------------------------------------- 
    268 CONTAINS 
    269    SUBROUTINE lim_rst_read             ! Empty routine 
    270    END SUBROUTINE lim_rst_read 
    271    SUBROUTINE lim_rst_write            ! Empty routine 
    272    END SUBROUTINE lim_rst_write 
    273273#endif 
    274274 
    275275   !!====================================================================== 
    276276END MODULE limrst 
     277 
  • trunk/NEMO/LIM_SRC/limthd.F90

    r476 r508  
    5252CONTAINS 
    5353 
    54    SUBROUTINE lim_thd 
     54   SUBROUTINE lim_thd( kt ) 
    5555      !!------------------------------------------------------------------- 
    5656      !!                ***  ROUTINE lim_thd  ***        
     
    7575      !!   2.0  !  02-07 (C. Ethe, G. Madec) F90 
    7676      !!--------------------------------------------------------------------- 
    77       !! * Local variables 
     77      INTEGER, INTENT(in) ::   kt     ! number of iteration 
     78 
    7879      INTEGER  ::   ji, jj,    &   ! dummy loop indices 
    7980         nbpb  ,               &   ! nb of icy pts for thermo. cal. 
     
    9899      !!------------------------------------------------------------------- 
    99100 
    100       IF( numit == nstart  )   CALL lim_thd_init  ! Initialization (first time-step only) 
     101      IF( kt == nit000  )   CALL lim_thd_init  ! Initialization (first time-step only) 
    101102    
    102103      !-------------------------------------------! 
  • trunk/NEMO/LIM_SRC/limtrp.F90

    r247 r508  
    5454CONTAINS 
    5555 
    56    SUBROUTINE lim_trp 
     56   SUBROUTINE lim_trp( kt ) 
    5757      !!------------------------------------------------------------------- 
    5858      !!                   ***  ROUTINE lim_trp *** 
     
    7171      !!   2.0  !  04-01 (G. Madec, C. Ethe)  F90, mpp 
    7272      !!--------------------------------------------------------------------- 
    73       !! * Local Variables 
     73      INTEGER, INTENT(in) ::   kt     ! number of iteration 
     74 
    7475      INTEGER  ::   ji, jj, jk,   &  ! dummy loop indices 
    7576         &          initad           ! number of sub-timestep for the advection 
     
    9697      !--------------------------------------------------------------------- 
    9798 
    98       IF( numit == nstart  )   CALL lim_trp_init      ! Initialization (first time-step only) 
     99      IF( kt == nit000  )   CALL lim_trp_init      ! Initialization (first time-step only) 
    99100 
    100101      zsm(:,:) = area(:,:) 
  • trunk/NEMO/LIM_SRC/limwri.F90

    r352 r508  
    44   !!         Ice diagnostics :  write ice output files 
    55   !!====================================================================== 
    6    !!---------------------------------------------------------------------- 
    7    !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    8    !! $Header$ 
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    10    !!---------------------------------------------------------------------- 
     6   !! history :  2.0  ! 03-08  (C. Ethe) original code 
     7   !!            2.0  ! 04-10  (C. Ethe )  1D configuration 
     8   !!------------------------------------------------------------------- 
    119#if defined key_ice_lim 
    1210   !!---------------------------------------------------------------------- 
    1311   !!   'key_ice_lim'                                     LIM sea-ice model 
     12   !!---------------------------------------------------------------------- 
    1413   !!---------------------------------------------------------------------- 
    1514   !!   lim_wri      : write of the diagnostics variables in ouput file  
    1615   !!   lim_wri_init : initialization and namelist read 
    1716   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    1917   USE ioipsl 
    2018   USE dianam    ! build name of file (routine) 
     
    2725   USE dom_ice 
    2826   USE ice 
    29    USE iceini 
    3027   USE lbclnk 
    3128 
     
    3330   PRIVATE 
    3431 
    35    !! * Accessibility 
    36    PUBLIC lim_wri        ! routine called by lim_step.F90 
    37  
    38    !! * Module variables 
    39    INTEGER, PARAMETER ::   &  !: 
    40       jpnoumax = 40             !: maximum number of variable for ice output 
    41    INTEGER  ::                                & 
    42       noumef                                     ! number of fields 
    43    REAL(wp)           , DIMENSION(jpnoumax) ::  & 
    44       cmulti ,                                &  ! multiplicative constant 
    45       cadd                                       ! additive constant 
    46    CHARACTER(len = 35), DIMENSION(jpnoumax) ::  & 
    47       titn                                       ! title of the field 
    48    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::  & 
    49       nam                                        ! name of the field 
    50    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::  & 
    51       uni                                        ! unit of the field 
    52    INTEGER            , DIMENSION(jpnoumax) ::  & 
    53       nc                                         ! switch for saving field ( = 1 ) or not ( = 0 ) 
     32   PUBLIC   lim_wri        ! routine called by lim_step.F90 
     33 
     34   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output 
     35   INTEGER                                  ::   noumef          ! number of fields 
     36   REAL(wp)           , DIMENSION(jpnoumax) ::   cmulti ,     &  ! multiplicative constant 
     37      &                                          cadd            ! additive constant 
     38   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn            ! title of the field 
     39   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam             ! name of the field 
     40   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni             ! unit of the field 
     41   INTEGER            , DIMENSION(jpnoumax) ::   nc              ! switch for saving field ( = 1 ) or not ( = 0 ) 
     42 
     43   INTEGER ::   nice, nhorid, ndim, niter, ndepid       ! ???? 
     44   INTEGER , DIMENSION( jpij ) ::   ndex51              ! ???? 
    5445 
    5546   REAL(wp)  ::            &  ! constant values 
     
    5748      zzero  = 0.e0     ,  & 
    5849      zone   = 1.e0 
    59    !!------------------------------------------------------------------- 
     50 
     51   !!---------------------------------------------------------------------- 
     52   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
     53   !! $Header$ 
     54   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     55   !!---------------------------------------------------------------------- 
    6056 
    6157CONTAINS 
     58 
    6259#if defined key_dimgout 
    63  
     60   !!---------------------------------------------------------------------- 
     61   !!   'key_dimgout'                                    Direct Access file 
     62   !!---------------------------------------------------------------------- 
    6463# include "limwri_dimg.h90" 
    65  
    6664#else 
    67  
    68    SUBROUTINE lim_wri 
    69       !!------------------------------------------------------------------- 
    70       !!  This routine computes the average of some variables and write it 
    71       !!  on the ouput files. 
    72       !!  ATTENTION cette routine n'est valable que si le pas de temps est 
    73       !!  egale a une fraction entiere de 1 jours. 
    74       !!  Diff 1-D 3-D : suppress common also included in etat 
    75       !!                 suppress cmoymo 11-18 
    76       !!  modif : 03/06/98 
    77       !!------------------------------------------------------------------- 
    78       !! * Local variables 
    79       REAL(wp),DIMENSION(1) ::   zdept 
    80        
    81       REAL(wp) :: & 
    82          zsto, zsec, zjulian,zout, & 
    83          zindh,zinda,zindb,  & 
    84          ztmu 
    85       REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 
    86          zcmo 
    87       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    88          zfield 
    89       INTEGER ::  ji, jj, jf   ! dummy loop indices 
    90  
    91       CHARACTER(len = 40)  :: & 
    92          clhstnam, clop 
    93  
    94       INTEGER , SAVE ::      & 
    95          nice, nhorid, ndim, niter, ndepid 
    96       INTEGER , DIMENSION( jpij ) , SAVE ::  & 
    97          ndex51   
    98       !!------------------------------------------------------------------- 
    99        
    100       IF ( numit == nstart ) THEN  
    101  
     65   !!---------------------------------------------------------------------- 
     66   !!   Default option                                          NetCDF file 
     67   !!---------------------------------------------------------------------- 
     68 
     69   SUBROUTINE lim_wri( kt ) 
     70      !!------------------------------------------------------------------- 
     71      !!                    ***   ROUTINE lim_wri  *** 
     72      !!                 
     73      !! ** Purpose :   write the sea-ice output file in NetCDF 
     74      !! 
     75      !! ** Method  :   computes the average of some variables and write 
     76      !!      it in the NetCDF ouput files 
     77      !!      CAUTION: the sea-ice time-step must be an integer fraction 
     78      !!      of a day 
     79      !!------------------------------------------------------------------- 
     80      INTEGER, INTENT(in) ::   kt     ! number of iteration 
     81 
     82      INTEGER  ::   ji, jj, jf                      ! dummy loop indices 
     83      CHARACTER(len = 40)  ::   clhstnam, clop 
     84      REAL(wp) ::   zsto, zsec, zjulian, zout,   &  ! temporary scalars 
     85         &          zindh, zinda, zindb, ztmu 
     86      REAL(wp), DIMENSION(1)                ::   zdept 
     87      REAL(wp), DIMENSION(jpi,jpj)          ::   zfield 
     88      REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo 
     89      !!------------------------------------------------------------------- 
     90 
     91      !                                          !--------------------! 
     92      IF ( kt == nit000 ) THEN                !   Initialisation   ! 
     93         !                                       !--------------------! 
    10294         CALL lim_wri_init  
    103           
    104          !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72 
    105          !  1) INITIALIZATIONS.                                                 | 
    106          !----------------------------------------------------------------------- 
    107           
    108          !-- essai NetCDF 
    109           
     95                            
    11096         zsto     = rdt_ice 
    11197!!Chris         clop     = "ave(only(x))"      !ibug  namelist parameter a ajouter 
     
    118104         CALL ymds2ju ( nyear, nmonth, nday, zsec, zjulian ) 
    119105         CALL dia_nam ( clhstnam, nwrite, 'icemod' ) 
    120          CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice , domain_id=nidom) 
     106         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    & 
     107            &           1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice , domain_id=nidom) 
    121108         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid) 
    122109         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    123110          
    124111         DO jf = 1, noumef 
    125             IF ( nc(jf) == 1 ) THEN 
    126                CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   & 
    127                   , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    128             ENDIF 
    129          END DO 
    130          CALL histend(nice) 
    131           
    132       ENDIF 
    133        
    134       !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72 
    135       !--2. Computation of instantaneous values                                         | 
    136       !----------------------------------------------------------------------- 
    137  
     112            IF ( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   & 
     113                  &                                , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     114         END DO 
     115         CALL histend( nice ) 
     116          
     117      ENDIF 
     118      !                                          !--------------------! 
     119      !                                          !   Cumulate at kt   ! 
     120      !                                          !--------------------! 
     121 
     122!!gm  change the print below to have it only at output time step or when nitend =< 100 
    138123      IF(lwp) THEN 
    139124         WRITE(numout,*) 
    140          WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit 
     125         WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, kt + nfice - 1 
    141126         WRITE(numout,*) '~~~~~~~ ' 
    142127      ENDIF 
     
    179164         END DO 
    180165      END DO 
    181                  
    182166      ! 
    183       ! ecriture d'un fichier netcdf 
     167      ! Write the netcdf file 
    184168      ! 
    185169      niter = niter + 1 
     
    205189         CALL histclo( nice )  
    206190      ENDIF 
    207        
     191      ! 
    208192   END SUBROUTINE lim_wri 
     193    
    209194#endif 
    210195    
     
    213198      !!                    ***   ROUTINE lim_wri_init  *** 
    214199      !!                 
    215       !! ** Purpose :   ??? 
     200      !! ** Purpose :   intialisation of LIM sea-ice output 
    216201      !! 
    217202      !! ** Method  : Read the namicewri namelist and check the parameter  
     
    219204      !! 
    220205      !! ** input   :   Namelist namicewri 
    221       !! 
    222       !! history : 
    223       !!  8.5  ! 03-08 (C. Ethe) original code 
    224       !!------------------------------------------------------------------- 
    225       !! * Local declarations 
     206      !!------------------------------------------------------------------- 
    226207      INTEGER ::   nf      ! ??? 
    227  
    228208      TYPE FIELD  
    229209         CHARACTER(len = 35) :: ztitle  
     
    234214         REAL                :: zcadd         
    235215      END TYPE FIELD 
    236  
    237216      TYPE(FIELD) ::  & 
    238217         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   & 
     
    240219         field_13, field_14, field_15, field_16, field_17, field_18,   & 
    241220         field_19 
    242  
    243221      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 
    244222 
     
    248226         field_13, field_14, field_15, field_16, field_17, field_18,   & 
    249227         field_19 
    250       !!------------------------------------------------------------------- 
    251  
     228!!gm      NAMELIST/namiceout/ noumef, & 
     229!!           zfield( 1), zfield( 2), zfield( 3), zfield( 4), zfield( 5),   & 
     230!!           zfield( 6), zfield( 7), zfield( 8), zfield( 9), zfield(10),   & 
     231!!           zfield(11), zfield(12), zfield(13), zfield(14), zfield(15),   & 
     232!!gm         zfield(16), zfield(17), zfield(18), zfield(19) 
     233      !!------------------------------------------------------------------- 
    252234 
    253235      ! Read Namelist namicewri 
    254236      REWIND ( numnam_ice ) 
    255237      READ   ( numnam_ice  , namiceout ) 
     238       
    256239      zfield(1)  = field_1 
    257240      zfield(2)  = field_2 
     
    295278         END DO 
    296279      ENDIF 
    297              
     280      !     
    298281   END SUBROUTINE lim_wri_init 
    299282 
  • trunk/NEMO/LIM_SRC/limwri_dimg.h90

    r284 r508  
    1     SUBROUTINE lim_wri 
     1    SUBROUTINE lim_wri(kt) 
    22   !!---------------------------------------------------------------------- 
    33   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
     
    1414    !!  modif : 03/06/98 
    1515    !!------------------------------------------------------------------- 
    16     !! * Local variables 
    1716    USE  diadimg                ! use of dia_wri_dimg 
     17 
     18    INTEGER, INTENT(in) ::   kt     ! number of iteration 
     19 
    1820    REAL(wp),DIMENSION(1) ::   zdept 
    1921 
     
    4850         ndex51   
    4951    !!------------------------------------------------------------------- 
    50     IF ( numit == nstart ) THEN  
     52    IF ( kt == nit000 ) THEN  
    5153 
    5254       CALL lim_wri_init  
     
    130132    nmoyice = nmoyice + 1  
    131133    ! compute mean value if it is time to write on file 
    132     IF ( MOD(numit-nit000+1,nwrite) == 0 ) THEN 
     134    IF ( MOD(kt+nfice-1-nit000+1,nwrite) == 0 ) THEN 
    133135       rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice) 
    134136#else   
    135        IF ( MOD(numit-nit000+1,nwrite) == 0 ) THEN  
     137       IF ( MOD(kt-nfice-1-nit000+1,nwrite) == 0 ) THEN  
    136138          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 
    137139          DO jj = 2 , jpjm1 
     
    200202          rcmoy(:,:,:) = 0.0 
    201203          nmoyice = 0  
    202        END IF     !  MOD(numit, nwrite == 0 ) ! 
     204       END IF     !  MOD(kt+nfice-1-nit000+1, nwrite == 0 ) ! 
    203205 
    204206     END SUBROUTINE lim_wri 
  • trunk/NEMO/OPA_SRC/DIA/diaptr.F90

    r460 r508  
    55   !!                 (please no more than 2 lines) 
    66   !!===================================================================== 
     7   !! History :  9.0  !  03-09  (C. Talandir, G. Madec)  Original code 
     8   !!            9.0  !  06-01  (A. Biastoch)  Allow sub-basins computation 
     9   !!---------------------------------------------------------------------- 
     10 
    711   !!---------------------------------------------------------------------- 
    812   !!   dia_ptr      : Poleward Transport Diagnostics module 
     
    1418   !!                : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d 
    1519   !!---------------------------------------------------------------------- 
    16    !! History : 
    17    !!   9.0  !  03-09  (C. Talandir, G. Madec)  Original code 
    18    !!   9.0  !  06-01  (A. Biastoch)  Allow sub-basins computation 
    19    !!---------------------------------------------------------------------- 
    20    !! * Modules used 
    2120   USE oce           ! ocean dynamics and active tracers 
    2221   USE dom_oce       ! ocean space and time domain 
     
    2625   USE dianam 
    2726   USE phycst 
    28    USE ioipsl          ! NetCDF IPSL library 
     27   USE iom 
     28   USE ioipsl          
    2929   USE daymod 
    3030 
     
    3636   END INTERFACE 
    3737 
    38    !! *  Routine accessibility 
    39    PUBLIC dia_ptr_init   ! call in opa module 
    40    PUBLIC dia_ptr        ! call in step module 
    41    PUBLIC ptr_vj         ! call by tra_ldf & tra_adv routines 
    42    PUBLIC ptr_vjk        ! call by tra_ldf & tra_adv routines 
    43  
    44    !! * Share Module variables 
    45    LOGICAL, PUBLIC ::       & !!! ** init namelist (namptr) ** 
    46       ln_diaptr = .FALSE.,  &  !: Poleward transport flag (T) or not (F) 
    47       ln_subbas = .FALSE.      !: Atlantic/Pacific/Indian basins calculation 
    48    INTEGER, PUBLIC ::       & !!: ** ptr namelist (namptr) ** 
    49       nf_ptr = 15              !: frequency of ptr computation 
    50    REAL(wp), PUBLIC, DIMENSION(jpj) ::   &   !!: poleward transport 
    51       pht_adv, pst_adv,     &  !: heat and salt: advection 
    52       pht_ove, pst_ove,     &  !: heat and salt: overturning 
    53       pht_ldf, pst_ldf,     &  !: heat and salt: lateral diffusion 
    54 #if defined key_diaeiv 
    55       pht_eiv, pst_eiv,     &  !: heat and salt: bolus advection 
    56 #endif 
    57       ht_atl,ht_ind,ht_pac, &  !: heat 
    58       st_atl,st_ind,st_pac     !: salt 
    59    REAL(wp),DIMENSION(jpi,jpj) ::   & 
    60       abasin,pbasin,ibasin     !: return function value 
     38   PUBLIC   dia_ptr_init   ! call in opa module 
     39   PUBLIC   dia_ptr        ! call in step module 
     40   PUBLIC   ptr_vj         ! call by tra_ldf & tra_adv routines 
     41   PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines 
     42 
     43   !!! ** init namelist (namptr) 
     44   LOGICAL , PUBLIC                 ::   ln_diaptr = .FALSE.   !: Poleward transport flag (T) or not (F) 
     45   LOGICAL , PUBLIC                 ::   ln_subbas = .FALSE.   !: Atlantic/Pacific/Indian basins calculation 
     46   INTEGER , PUBLIC                 ::   nf_ptr = 15           !: frequency of ptr computation 
     47 
     48   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_adv, pst_adv      !: heat and salt poleward transport: advection 
     49   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove, pst_ove      !: heat and salt poleward transport: overturning 
     50   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ldf, pst_ldf      !: heat and salt poleward transport: lateral diffusion 
     51#if defined key_diaeiv 
     52   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv, pst_eiv      !: heat and salt poleward transport: bolus advection 
     53#endif 
     54   REAL(wp), PUBLIC, DIMENSION(jpj) ::   ht_atl,ht_ind,ht_pac  !: heat 
     55   REAL(wp), PUBLIC, DIMENSION(jpj) ::   st_atl,st_ind,st_pac  !: salt 
     56 
    6157      
    6258 
    63    !! Module variables 
    64    REAL(wp), DIMENSION(jpj,jpk) ::   &   
    65       tn_jk  , sn_jk  ,  &  !: "zonal" mean temperature and salinity 
    66       v_msf_atl       ,  &  !: "meridional" Stream-Function 
    67       v_msf_glo       ,  &  !: "meridional" Stream-Function 
    68       v_msf_ipc       ,  &  !: "meridional" Stream-Function 
    69 #if defined key_diaeiv 
    70       v_msf_eiv       ,  &  !: bolus "meridional" Stream-Function 
    71 #endif 
    72       surf_jk_r             !: inverse of the ocean "zonal" section surface 
     59   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk  , sn_jk  ,  &  !: "zonal" mean temperature and salinity 
     60      &                              v_msf_atl       ,  &  !: "meridional" Stream-Function 
     61      &                              v_msf_glo       ,  &  !: "meridional" Stream-Function 
     62      &                              v_msf_ipc       ,  &  !: "meridional" Stream-Function 
     63      &                              surf_jk_r             !: inverse of the ocean "zonal" section surface 
     64#if defined key_diaeiv 
     65   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv                  !: bolus "meridional" Stream-Function 
     66#endif 
     67   REAL(wp), DIMENSION(jpi,jpj) ::   abasin, pbasin, ibasin     !: return function value 
    7368 
    7469   !! * Substitutions 
     
    7873   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    7974   !! $Header$  
    80    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     75   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    8176   !!---------------------------------------------------------------------- 
    8277 
     
    9489      !! 
    9590      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    96       !! 
    97       !!---------------------------------------------------------------------- 
    98       !! * arguments 
    99       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   & 
    100          pva                         ! mask flux array at V-point 
    101  
    102       !! * local declarations 
    103       INTEGER  ::   ji, jj, jk        ! dummy loop arguments 
    104       INTEGER  ::   ijpj             ! ??? 
    105       REAL(wp),DIMENSION(jpj) ::   & 
    106          p_fval                       ! function value 
     91      !!---------------------------------------------------------------------- 
     92      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
     93      !! 
     94      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
     95      INTEGER                  ::   ijpj         ! ??? 
     96      REAL(wp), DIMENSION(jpj) ::   p_fval       ! function value 
    10797      !!-------------------------------------------------------------------- 
    108  
     98      ! 
    10999      ijpj = jpj 
    110100      p_fval(:) = 0.e0 
     
    116106         END DO 
    117107      END DO 
    118  
     108      ! 
    119109      IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj )     !!bug  I presume 
    120  
     110      ! 
    121111   END FUNCTION ptr_vj_3d 
    122  
    123112 
    124113 
     
    134123      !! 
    135124      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    136       !! 
    137       !!---------------------------------------------------------------------- 
    138       !! * arguments 
    139       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   & 
    140          pva                         ! mask flux array at V-point 
    141  
    142       !! * local declarations 
    143       INTEGER  ::   ji,jj             ! dummy loop arguments 
    144       INTEGER  ::   ijpj             ! ??? 
    145       REAL(wp),DIMENSION(jpj) ::   & 
    146          p_fval                       ! function value 
     125      !!---------------------------------------------------------------------- 
     126      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point 
     127      !! 
     128      INTEGER                  ::   ji,jj    ! dummy loop arguments 
     129      INTEGER                  ::   ijpj     ! ??? 
     130      REAL(wp), DIMENSION(jpj) ::   p_fval   ! function value 
    147131      !!-------------------------------------------------------------------- 
    148        
     132      !  
    149133      ijpj = jpj 
    150134      p_fval(:) = 0.e0 
     
    154138         END DO 
    155139      END DO 
    156  
     140      ! 
    157141      IF( lk_mpp )   CALL mpp_sum( p_fval, ijpj )     !!bug  I presume 
    158   
    159     END FUNCTION ptr_vj_2d 
    160  
     142      !  
     143   END FUNCTION ptr_vj_2d 
    161144 
    162145 
     
    171154      !! 
    172155      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    173       !! 
    174       !!---------------------------------------------------------------------- 
    175       !! * arguments 
    176       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   & 
    177          pva                         ! mask flux array at V-point 
    178  
    179       !! * local declarations 
    180       INTEGER  ::   ji, jj, jk        ! dummy loop arguments 
    181       INTEGER, DIMENSION (1) :: ish 
    182       INTEGER, DIMENSION (2) :: ish2 
    183       REAL(wp),DIMENSION(jpj*jpk) ::   & 
    184          zwork                        ! temporary vector for mpp_sum 
    185       REAL(wp),DIMENSION(jpj,jpk) ::   & 
    186          p_fval                       ! return function value 
     156      !!---------------------------------------------------------------------- 
     157      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
     158      !! 
     159      INTEGER                      ::   ji, jj, jk   ! dummy loop arguments 
     160      INTEGER , DIMENSION (1)      ::   ish 
     161      INTEGER , DIMENSION (2)      ::   ish2 
     162      REAL(wp), DIMENSION(jpj*jpk) ::   zwork        ! temporary vector for mpp_sum 
     163      REAL(wp), DIMENSION(jpj,jpk) ::   p_fval       ! return function value 
    187164      !!-------------------------------------------------------------------- 
    188   
     165      !  
    189166      p_fval(:,:) = 0.e0 
    190  
     167      ! 
    191168      DO jk = 1, jpkm1 
    192169         DO jj = 2, jpjm1 
     
    197174         END DO 
    198175      END DO 
    199  
     176      ! 
    200177      IF(lk_mpp) THEN 
    201178         ish(1) = jpj*jpk  ;  ish2(1) = jpj  ;  ish2(2) = jpk 
     
    204181         p_fval(:,:)= RESHAPE( zwork, ish2 ) 
    205182      END IF 
    206  
     183      ! 
    207184   END FUNCTION ptr_vjk 
     185 
    208186 
    209187   FUNCTION ptr_vtjk( pva )   RESULT ( p_fval ) 
     
    218196      !! 
    219197      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    220       !! 
    221       !!---------------------------------------------------------------------- 
    222       !! * arguments 
    223       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   & 
    224          pva                         ! mask flux array at V-point 
    225   
    226       !! * local declarations 
    227       INTEGER  ::   ji, jj, jk        ! dummy loop arguments 
    228       INTEGER, DIMENSION (1) :: ish 
    229       INTEGER, DIMENSION (2) :: ish2 
    230       REAL(wp),DIMENSION(jpj*jpk) ::   & 
    231          zwork                        ! temporary vector for mpp_sum 
    232       REAL(wp),DIMENSION(jpj,jpk) ::   & 
    233          p_fval                       ! return function value 
     198      !!---------------------------------------------------------------------- 
     199      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
     200      !! 
     201      INTEGER                     ::   ji, jj, jk   ! dummy loop arguments 
     202      INTEGER, DIMENSION (1)      ::   ish 
     203      INTEGER, DIMENSION (2)      ::   ish2 
     204      REAL(wp),DIMENSION(jpj*jpk) ::   zwork        ! temporary vector for mpp_sum 
     205      REAL(wp),DIMENSION(jpj,jpk) ::   p_fval       ! return function value 
    234206      !!--------------------------------------------------------------------  
    235  
     207      ! 
    236208      p_fval(:,:) = 0.e0 
    237209      DO jk = 1, jpkm1 
     
    251223         p_fval(:,:)= RESHAPE(zwork,ish2) 
    252224      END IF 
    253  
     225      ! 
    254226   END FUNCTION ptr_vtjk 
    255227 
     
    259231      !!                  ***  ROUTINE dia_ptr  *** 
    260232      !!---------------------------------------------------------------------- 
    261       !! * Moudules used 
    262       USE ioipsl 
    263  
    264       !! * Argument 
    265233      INTEGER, INTENT(in) ::   kt   ! ocean time step index 
    266  
    267       !! * Local variables 
    268       INTEGER ::   jk,jj,ji               ! dummy loop 
    269       REAL(wp) ::    & 
    270          zsverdrup,  &              ! conversion from m3/s to Sverdrup 
    271          zpwatt,     &              ! conversion from W    to PW 
    272          zggram                     ! conversion from g    to Pg 
     234      !! 
     235      INTEGER  ::   jk, jj, ji               ! dummy loop 
     236      REAL(wp) ::   zsverdrup,  &              ! conversion from m3/s to Sverdrup 
     237         &          zpwatt,     &              ! conversion from W    to PW 
     238         &          zggram                     ! conversion from g    to Pg 
    273239 
    274240      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  & 
     
    277243         vs_atl, vs_pac, vs_ind,           & 
    278244         zv_eiv 
    279       CHARACTER (len=32) ::   & 
    280          clnam = 'subbasins.nc'                 
    281       INTEGER ::  itime,inum,ipi,ipj,ipk       ! temporary integer 
    282       INTEGER, DIMENSION (1) ::   istep 
    283       REAL(wp) ::    zdate0,zsecond,zdt        ! temporary scalars 
    284       REAL(wp), DIMENSION(jpidta,jpjdta) ::   & 
    285          zlamt, zphit, zdta             ! temporary workspace (NetCDF read) 
    286       REAL(wp), DIMENSION(jpk) ::   & 
    287          zdept                          ! temporary workspace (NetCDF read) 
     245      INTEGER ::  inum       ! temporary logical unit 
    288246      !!---------------------------------------------------------------------- 
    289247 
     
    293251         zpwatt    = 1.e-15 
    294252         zggram    = 1.e-6 
    295          ipi       = jpidta 
    296          ipj       = jpjdta 
    297          ipk       = 1 
    298          itime     = 1 
    299          zsecond   = 0.e0 
    300          zdate0    = 0.e0 
    301253    
    302254# if defined key_diaeiv 
     
    315267         IF( ln_subbas ) THEN              ! Basins computation 
    316268 
    317             IF( kt == nit000 ) THEN                ! load basin mask 
    318                itime = 1 
    319                ipi   = jpidta 
    320                ipj   = jpjdta 
    321                ipk   = 1 
    322                zdt   = 0.e0 
    323                istep = 0 
    324                clnam = 'subbasins.nc' 
    325  
    326                CALL flinopen(clnam,1,jpidta,1,jpjdta,.FALSE.,ipi,ipj, & 
    327                   &          ipk,zlamt,zphit,zdept,itime,istep,zdate0,zdt,inum) 
    328  
    329                ! get basins: 
    330                abasin (:,:) = 0.e0 
    331                pbasin (:,:) = 0.e0 
    332                ibasin (:,:) = 0.e0 
    333  
    334                ! Atlantic basin 
    335                CALL flinget(inum,'atlmsk',jpidta,jpjdta,1,itime,1,   & 
    336                   &         0,1,jpidta,1,jpjdta,zdta(:,:)) 
    337                DO jj = 1, nlcj                                 ! interior values 
    338                   DO ji = 1, nlci 
    339                      abasin (ji,jj) = zdta( mig(ji), mjg(jj) ) 
    340                   END DO 
    341                END DO 
    342  
    343                ! Pacific basin 
    344                CALL flinget(inum,'pacmsk',jpidta,jpjdta,1,itime,1,   & 
    345                   &         0,1,jpidta,1,jpjdta,zdta(:,:)) 
    346                DO jj = 1, nlcj                                 ! interior values 
    347                   DO ji = 1, nlci 
    348                      pbasin (ji,jj) = zdta( mig(ji), mjg(jj) ) 
    349                   END DO 
    350                END DO 
    351  
    352                ! Indian basin 
    353                CALL flinget(inum,'indmsk',jpidta,jpjdta,1,itime,1,   & 
    354                   &         0,1,jpidta,1,jpjdta,zdta(:,:)) 
    355                DO jj = 1, nlcj                                 ! interior values 
    356                   DO ji = 1, nlci 
    357                      ibasin (ji,jj) = zdta( mig(ji), mjg(jj) ) 
    358                   END DO 
    359                END DO 
    360  
    361                CALL flinclo(inum) 
    362  
     269            IF( kt == nit000 ) THEN                ! load sub-basin mask 
     270               CALL iom_open( 'subbasins', inum ) 
     271               CALL iom_get( inum, jpdom_data, 'atlmsk', abasin )      ! Atlantic basin 
     272               CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin )      ! Pacific basin 
     273               CALL iom_get( inum, jpdom_data, 'indmsk', ibasin )      ! Indian basin 
     274               CALL iom_close( inum ) 
    363275            ENDIF 
    364276 
     
    396308#endif 
    397309         IF( ln_subbas ) THEN 
    398             v_msf_atl(:,:) = ptr_vjk( v_atl(:,:,:) )  
    399             v_msf_ipc(:,:) = ptr_vjk( v_ipc(:,:,:) )  
    400             ht_atl(:) = SUM(ptr_vjk( vt_atl(:,:,:)),2 ) 
    401             ht_pac(:) = SUM(ptr_vjk( vt_pac(:,:,:)),2 ) 
    402             ht_ind(:) = SUM(ptr_vjk( vt_ind(:,:,:)),2 ) 
    403             st_atl(:) = SUM(ptr_vjk( vs_atl(:,:,:)),2 ) 
    404             st_pac(:) = SUM(ptr_vjk( vs_pac(:,:,:)),2 ) 
    405             st_ind(:) = SUM(ptr_vjk( vs_ind(:,:,:)),2 ) 
     310            v_msf_atl(:,:) = ptr_vjk( v_atl (:,:,:) )  
     311            v_msf_ipc(:,:) = ptr_vjk( v_ipc (:,:,:) )  
     312            ht_atl(:) = SUM( ptr_vjk( vt_atl(:,:,:)), 2 ) 
     313            ht_pac(:) = SUM( ptr_vjk( vt_pac(:,:,:)), 2 ) 
     314            ht_ind(:) = SUM( ptr_vjk( vt_ind(:,:,:)), 2 ) 
     315            st_atl(:) = SUM( ptr_vjk( vs_atl(:,:,:)), 2 ) 
     316            st_pac(:) = SUM( ptr_vjk( vs_pac(:,:,:)), 2 ) 
     317            st_ind(:) = SUM( ptr_vjk( vs_ind(:,:,:)), 2 ) 
    406318         ENDIF 
    407319 
     
    466378      ! Close the file 
    467379      IF( kt == nitend ) CALL histclo( numptr ) 
    468  
     380      ! 
    469381   END SUBROUTINE dia_ptr 
    470382 
     
    475387      !!                    
    476388      !! ** Purpose :   Initialization, namelist read 
    477       !! 
    478389      !!---------------------------------------------------------------------- 
    479390      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z_1         ! temporary workspace 
     
    485396      REWIND ( numnam ) 
    486397      READ   ( numnam, namptr ) 
    487  
    488398 
    489399      ! Control print 
     
    513423      !! 
    514424      !! ** Method  :   NetCDF file 
    515       !! 
    516       !!---------------------------------------------------------------------- 
    517       !! * Arguments 
     425      !!---------------------------------------------------------------------- 
    518426      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    519  
    520       !! * Save variables    
     427      !! 
    521428      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw, ndex(1) 
    522429 
    523       !! * Local variables 
    524       CHARACTER (len=40) ::   & 
    525          clhstnam, clop             ! temporary names 
    526       INTEGER ::   iline, it, ji    ! 
    527       REAL(wp) ::   & 
    528          zsto, zout, zdt, zmax, &   ! temporary scalars 
    529          zjulian 
     430      CHARACTER (len=40)       ::   clhstnam, clop                   ! temporary names 
     431      INTEGER                  ::   iline, it, ji                    ! 
     432      REAL(wp)                 ::   zsto, zout, zdt, zmax, zjulian   ! temporary scalars 
    530433      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo 
    531434      !!---------------------------------------------------------------------- 
     
    720623  
    721624      ENDIF 
    722  
     625      ! 
    723626   END SUBROUTINE dia_ptr_wri 
    724627 
  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r474 r508  
    44   !! Ocean dynamics:  surface pressure gradient trend 
    55   !!====================================================================== 
    6 #if ( defined key_dynspg_flt && ! defined key_mpp_omp )   ||   defined key_esopa 
     6   !! History    8.0  !  98-05  (G. Roullet)  free surface 
     7   !!                 !  98-10  (G. Madec, M. Imbard)  release 8.2 
     8   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     9   !!            " "  !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
     10   !!            9.0  !  04-08  (C. Talandier) New trends organization 
     11   !!            " "  !  05-11  (V. Garnier) Surface pressure gradient organization 
     12   !!            " "  !  06-07  (S. Masson)  distributed restart using iom 
     13   !!---------------------------------------------------------------------- 
     14#if ( defined key_dynspg_flt  && ! defined key_mpp_omp )  ||   defined key_esopa   
    715   !!---------------------------------------------------------------------- 
    816   !!   'key_dynspg_flt'                              filtered free surface 
    917   !!   NOT 'key_mpp_omp'                          k-j-i loop (vector opt.) 
     18   !!---------------------------------------------------------------------- 
    1019   !!---------------------------------------------------------------------- 
    1120   !!   dyn_spg_flt  : update the momentum trend with the surface pressure 
    1221   !!                  gradient in the filtered free surface case with 
    1322   !!                  vector optimization 
    14    !!---------------------------------------------------------------------- 
    15    !! * Modules used 
     23   !!   flt_rst      : read/write the time-splitting restart fields in the ocean restart file 
     24   !!---------------------------------------------------------------------- 
    1625   USE oce             ! ocean dynamics and tracers  
    1726   USE dom_oce         ! ocean space and time domain  
     
    2130   USE flxrnf          ! ocean runoffs 
    2231   USE sol_oce         ! ocean elliptic solver 
     32   USE solver          ! solver initialization 
    2333   USE solpcg          ! preconditionned conjugate gradient solver 
    2434   USE solsor          ! Successive Over-relaxation solver 
     
    3242   USE cla_dynspg      ! cross land advection 
    3343   USE prtctl          ! Print control 
    34    USE in_out_manager  ! I/O manager 
    3544   USE solmat          ! matrix construction for elliptic solvers 
    3645   USE agrif_opa_interp 
     46   USE in_out_manager  ! I/O manager 
     47   USE iom 
     48   USE restart         ! only for lrst_oce 
    3749 
    3850   IMPLICIT NONE 
    3951   PRIVATE 
    4052 
    41    !! * Accessibility 
    4253   PUBLIC dyn_spg_flt  ! routine called by step.F90 
    4354 
     
    4859   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    4960   !! $Header$  
    50    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     61   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    5162   !!---------------------------------------------------------------------- 
    5263 
     
    96107      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 
    97108      !! 
    98       !! References : 
    99       !!      Roullet and Madec 1999, JGR. 
    100       !! 
    101       !! History : 
    102       !!        !  98-05 (G. Roullet)  Original code 
    103       !!        !  98-10 (G. Madec, M. Imbard)  release 8.2 
    104       !!   8.5  !  02-08 (G. Madec)  F90: Free form and module 
    105       !!        !  02-11 (C. Talandier, A-M Treguier) Open boundaries 
    106       !!   9.0  !  04-08 (C. Talandier) New trends organization 
    107       !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
     109      !! References : Roullet and Madec 1999, JGR. 
    108110      !!--------------------------------------------------------------------- 
    109       !! * Arguments 
    110111      INTEGER, INTENT( in )  ::   kt         ! ocean time-step index 
    111       INTEGER, INTENT( out ) ::   kindic     ! solver convergence flag 
    112                                              ! if the solver doesn t converge 
    113                                              ! the flag is < 0 
    114       !! * Local declarations 
    115       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    116       REAL(wp) ::                         &  
    117          z2dt, z2dtg, zraur, znugdt,      &  ! temporary scalars 
    118          znurau, zssha, zgcb, zbtd,       &  !   "          " 
    119          ztdgu, ztdgv                        !   "          " 
     112      INTEGER, INTENT( out ) ::   kindic     ! solver convergence flag (<0 if not converge) 
     113      !!                                    
     114      INTEGER  ::   ji, jj, jk                          ! dummy loop indices 
     115      REAL(wp) ::   z2dt, z2dtg, zraur, znugdt,      &  ! temporary scalars 
     116         &          znurau, zssha, zgcb, zbtd,       &  !   "          " 
     117         &          ztdgu, ztdgv                        !   "          " 
    120118      !!---------------------------------------------------------------------- 
    121  
     119      ! 
    122120      IF( kt == nit000 ) THEN 
    123121         IF(lwp) WRITE(numout,*) 
     
    128126         spgu(:,:) = 0.e0                     ! surface pressure gradient (i-direction) 
    129127         spgv(:,:) = 0.e0                     ! surface pressure gradient (j-direction) 
     128         CALL solver_init( nit000 )           ! Elliptic solver initialisation 
     129 
     130         ! read filtered free surface arrays in restart file 
     131         CALL flt_rst( nit000, 'READ' )       ! read or initialize the following fields: 
     132         !                                    ! gcx, gcxb, sshb, sshn 
    130133      ENDIF 
    131134 
     
    168171 
    169172#if defined key_obc 
    170       ! Update velocities on each open boundary with the radiation algorithm 
    171       CALL obc_dyn( kt ) 
    172       ! Correction of the barotropic componant velocity to control the volume of the system 
    173       CALL obc_vol( kt ) 
     173      CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm 
     174      CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system 
    174175#endif 
    175176#if defined key_agrif 
    176       ! Update velocities on each coarse/fine interfaces 
    177  
    178       CALL Agrif_dyn( kt ) 
     177      CALL Agrif_dyn( kt )    ! Update velocities on each coarse/fine interfaces  
    179178#endif 
    180179#if defined key_orca_r2 
     
    243242      IF( .NOT. AGRIF_ROOT() ) THEN 
    244243         ! add contribution of gradient of after barotropic transport divergence  
    245          IF( (nbondi == -1) .OR. (nbondi == 2) ) gcb(3,:) = gcb(3,:) & 
    246             &            -znugdt * z2dt*laplacu(2,:)*gcdprc(3,:)*hu(2,:)*e2u(2,:) 
    247          IF( (nbondi ==  1) .OR. (nbondi == 2) )  gcb(nlci-2,:) = gcb(nlci-2,:) & 
    248             &           +znugdt * z2dt*laplacu(nlci-2,:)*gcdprc(nlci-2,:)*hu(nlci-2,:)*e2u(nlci-2,:) 
    249          IF( (nbondj == -1) .OR. (nbondj == 2) ) gcb(:,3) = gcb(:,3) & 
    250             &           -znugdt * z2dt*laplacv(:,2)*gcdprc(:,3)*hv(:,2)*e1v(:,2) 
    251          IF( (nbondj ==  1) .OR. (nbondj == 2) )  gcb(:,nlcj-2) = gcb(:,nlcj-2) & 
    252             &           +znugdt * z2dt*laplacv(:,nlcj-2)*gcdprc(:,nlcj-2)*hv(:,nlcj-2)*e1v(:,nlcj-2) 
     244         IF( nbondi == -1 .OR. nbondi == 2 )   gcb(3     ,:) =  & 
     245            &    gcb(3     ,:) - znugdt * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu(2     ,:) * e2u(2     ,:) 
     246         IF( nbondi ==  1 .OR. nbondi == 2 )   gcb(nlci-2,:) =  & 
     247            &    gcb(nlci-2,:) + znugdt * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:) 
     248         IF( nbondj == -1 .OR. nbondj == 2 )   gcb(:     ,3) =  & 
     249            &    gcb(:,3     ) - znugdt * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv(:,2     ) * e1v(:,2     ) 
     250         IF( nbondj ==  1 .OR. nbondj == 2 )   gcb(:,nlcj-2) =  & 
     251            &    gcb(:,nlcj-2) + znugdt * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2) 
    253252      ENDIF 
    254253#endif 
     
    263262      epsr = eps * eps * rnorme 
    264263      ncut = 0 
    265       ! if rnorme is 0, the solution is 0, the solver isn't called 
     264      ! if rnorme is 0, the solution is 0, the solver is not called 
    266265      IF( rnorme == 0.e0 ) THEN 
    267266         gcx(:,:) = 0.e0 
     
    313312      IF( .NOT. Agrif_Root() ) THEN 
    314313         ! caution : grad D (fine) = grad D (coarse) at coarse/fine interface 
    315          IF( (nbondi == -1) .OR. (nbondi == 2) ) spgu(2,:) = znugdt * z2dt * laplacu(2,:) * umask(2,:,1) 
    316          IF( (nbondi ==  1) .OR. (nbondi == 2) ) spgu(nlci-2,:) = znugdt * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1) 
    317          IF( (nbondj == -1) .OR. (nbondj == 2) ) spgv(:,2) = znugdt * z2dt * laplacv(:,2) * vmask(:,2,1) 
    318          IF( (nbondj ==  1) .OR. (nbondj == 2) ) spgv(:,nlcj-2) = znugdt * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1) 
     314         IF( nbondi == -1 .OR. nbondi == 2 ) spgu(2     ,:) = znugdt * z2dt * laplacu(2     ,:) * umask(2     ,:,1) 
     315         IF( nbondi ==  1 .OR. nbondi == 2 ) spgu(nlci-2,:) = znugdt * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1) 
     316         IF( nbondj == -1 .OR. nbondj == 2 ) spgv(:,2     ) = znugdt * z2dt * laplacv(:,2     ) * vmask(:     ,2,1) 
     317         IF( nbondj ==  1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = znugdt * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1) 
    319318      ENDIF 
    320319#endif       
     
    323322      !     ( c a u t i o n : (ua,va) here are the after velocity not the 
    324323      !                       trend, the leap-frog time stepping will not 
    325       !                       be done in dynnxt.F routine) 
     324      !                       be done in dynnxt.F90 routine) 
    326325      DO jk = 1, jpkm1 
    327326         DO jj = 2, jpjm1 
     
    332331         END DO 
    333332      END DO 
    334  
    335333 
    336334      ! Sea surface elevation time stepping 
     
    358356      ENDIF 
    359357 
    360       !                       ! print sum trends (used for debugging) 
    361       IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshn, clinfo1=' spg  - ssh: ', mask1=tmask ) 
    362  
     358      ! write filtered free surface arrays in restart file 
     359      ! -------------------------------------------------- 
     360      IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) 
     361 
     362      ! print sum trends (used for debugging) 
     363      IF(ln_ctl)     CALL prt_ctl( tab2d_1=sshn, clinfo1=' spg  - ssh: ', mask1=tmask ) 
     364      ! 
    363365   END SUBROUTINE dyn_spg_flt 
     366 
     367 
     368   SUBROUTINE flt_rst( kt, cdrw ) 
     369     !!--------------------------------------------------------------------- 
     370     !!                   ***  ROUTINE ts_rst  *** 
     371     !! 
     372     !! ** Purpose : Read or write filtered free surface arrays in restart file 
     373     !!---------------------------------------------------------------------- 
     374     INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     375     CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     376     !!---------------------------------------------------------------------- 
     377 
     378     IF( TRIM(cdrw) == 'READ' ) THEN 
     379        IF( iom_varid( numror, 'gcx' ) > 0 ) THEN 
     380! Caution : extra-hallow 
     381! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
     382           CALL iom_get( numror, jpdom_local, 'gcx' , gcx (1:jpi,1:jpj) ) 
     383           CALL iom_get( numror, jpdom_local, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     384           CALL iom_get( numror, jpdom_local, 'sshb', sshb(:,:)         ) 
     385           CALL iom_get( numror, jpdom_local, 'sshn', sshn(:,:)         ) 
     386           IF( neuler == 0 ) THEN 
     387              sshb(:,:) = sshn(:,:) 
     388              gcxb(:,:) = gcx (:,:) 
     389           ENDIF 
     390        ELSE 
     391           gcx (:,:) = 0.e0 
     392           gcxb(:,:) = 0.e0 
     393           sshb(:,:) = 0.e0 
     394           sshn(:,:) = 0.e0 
     395        ENDIF 
     396     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     397! Caution : extra-hallow 
     398! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
     399        CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx( 1:jpi,1:jpj) ) 
     400        CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     401        CALL iom_rstput( kt, nitrst, numrow, 'sshb', sshb(:,:)         ) 
     402        CALL iom_rstput( kt, nitrst, numrow, 'sshn', sshn(:,:)         ) 
     403     ENDIF 
     404     ! 
     405   END SUBROUTINE flt_rst 
    364406 
    365407#else 
  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt_jki.F90

    r503 r508  
    2525   USE solfet          ! FETI solver 
    2626   USE solsor_e        ! Successive Over-relaxation solver with MPP optimization 
     27   USE solver 
    2728   USE obc_oce         ! Lateral open boundary condition 
    2829   USE obcdyn          ! ocean open boundary condition (obc_dyn routines) 
     
    3536   USE solmat          ! matrix construction for elliptic solvers 
    3637   USE agrif_opa_interp 
     38   USE restart         ! only for lrst_oce 
     39   USE iom 
    3740 
    3841   IMPLICIT NONE 
     
    112115         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~  (free surface constant volume, autotasking case)' 
    113116 
    114          ! set to zero free surface specific arrays  
    115          spgu(:,:) = 0.e0      ! surface pressure gradient (i-direction) 
    116          spgv(:,:) = 0.e0      ! surface pressure gradient (j-direction) 
     117         ! set to zero free surface specific arrays 
     118         spgu(:,:) = 0.e0                     ! surface pressure gradient (i-direction) 
     119          
     120         spgv(:,:) = 0.e0                     ! surface pressure gradient (j-direction) 
     121          
     122         CALL solver_init( nit000 )           ! Elliptic solver initialisation 
     123 
     124         ! read filtered free surface arrays in restart file 
     125         CALL flt_rst( nit000, 'READ' )       ! read or initialize the following fields: 
     126         !                                    ! gcx, gcxb, sshb, sshn 
    117127      ENDIF 
    118128 
     
    354364      CALL lbc_lnk( sshn, 'T', 1. ) 
    355365 
     366      ! write filtered free surface arrays in restart file 
     367      ! -------------------------------------------------- 
     368      IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) 
     369 
    356370      IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    357371         CALL prt_ctl( tab3d_1=ua  , clinfo1=' spg  - Ua : ', mask1=umask,   & 
     
    362376   END SUBROUTINE dyn_spg_flt_jki 
    363377 
     378   SUBROUTINE flt_rst( kt, cdrw ) 
     379     !!--------------------------------------------------------------------- 
     380     !!                   ***  ROUTINE ts_rst  *** 
     381     !! 
     382     !! ** Purpose : Read or write filtered free surface arrays in restart file 
     383     !!---------------------------------------------------------------------- 
     384     INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     385     CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     386     !!---------------------------------------------------------------------- 
     387 
     388     IF( TRIM(cdrw) == 'READ' ) THEN 
     389        IF( iom_varid( numror, 'gcx' ) > 0 ) THEN 
     390! Caution : extra-hallow 
     391! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
     392           CALL iom_get( numror, jpdom_local, 'gcx' , gcx (1:jpi,1:jpj) ) 
     393           CALL iom_get( numror, jpdom_local, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     394           CALL iom_get( numror, jpdom_local, 'sshb', sshb(:,:)         ) 
     395           CALL iom_get( numror, jpdom_local, 'sshn', sshn(:,:)         ) 
     396           IF( neuler == 0 ) THEN 
     397              sshb(:,:) = sshn(:,:) 
     398              gcxb(:,:) = gcx (:,:) 
     399           ENDIF 
     400        ELSE 
     401           gcx (:,:) = 0.e0 
     402           gcxb(:,:) = 0.e0 
     403           sshb(:,:) = 0.e0 
     404           sshn(:,:) = 0.e0 
     405        ENDIF 
     406     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     407! Caution : extra-hallow 
     408! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
     409        CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx( 1:jpi,1:jpj) ) 
     410        CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     411        CALL iom_rstput( kt, nitrst, numrow, 'sshb', sshb(:,:)         ) 
     412        CALL iom_rstput( kt, nitrst, numrow, 'sshn', sshn(:,:)         ) 
     413     ENDIF 
     414     ! 
     415   END SUBROUTINE flt_rst 
     416 
    364417#else 
    365418   !!---------------------------------------------------------------------- 
  • trunk/NEMO/OPA_SRC/DYN/dynspg_rl.F90

    r474 r508  
    44   !! Ocean dynamics:  surface pressure gradient trend 
    55   !!====================================================================== 
     6   !! History :  7.0  !  96-05  (G. Madec, M. Imbard, M. Guyon)  rewitting in 1 
     7   !!                           routine, without pointers, and with the same matrix 
     8   !!                           for sor and pcg, mpp exchange, and symmetric conditions 
     9   !!            " "  !  96-07  (A. Weaver)  Euler forward step 
     10   !!            " "  !  96-11  (A. Weaver)  correction to preconditioning: 
     11   !!            8.0  !  98-02  (M. Guyon)  FETI method 
     12   !!            " "  !  97-09  (J.-M. Molines)  Open boundaries 
     13   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
     14   !!                 !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
     15   !!            9.0  !  04-08  (C. Talandier)  New trends organization 
     16   !!            " "  !  05-11  (V. Garnier) Surface pressure gradient organization 
     17   !!            " "  !  06-07  (S. Masson)  distributed restart using iom 
     18   !!--------------------------------------------------------------------- 
    619#if   defined key_dynspg_rl   ||   defined key_esopa 
    720   !!---------------------------------------------------------------------- 
     
    1023   !!   dyn_spg_rl   : update the momentum trend with the surface pressure 
    1124   !!                  for the rigid-lid case. 
    12    !!---------------------------------------------------------------------- 
    13    !! * Modules used 
     25   !!   rl_rst       : read/write the rigid-lid restart fields in the ocean restart file 
     26   !!---------------------------------------------------------------------- 
    1427   USE oce             ! ocean dynamics and tracers 
    1528   USE dom_oce         ! ocean space and time domain 
     
    1932   USE zdf_oce         ! ocean vertical physics 
    2033   USE sol_oce         ! ocean elliptic solver 
     34   USE solver          ! solver initialization 
    2135   USE solpcg          ! preconditionned conjugate gradient solver 
    2236   USE solsor          ! Successive Over-relaxation solver 
     
    2842   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2943   USE in_out_manager  ! I/O manager 
     44   USE iom 
     45   USE restart         ! only for lrst_oce 
    3046 
    3147   IMPLICIT NONE 
    3248   PRIVATE 
    3349 
    34    !! * Accessibility 
    3550   PUBLIC dyn_spg_rl   ! called by step.F90 
    3651 
     
    4257   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    4358   !! $Header$  
    44    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     59   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    4560   !!---------------------------------------------------------------------- 
    4661 
     
    7691      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 
    7792      !! 
    78       !! References : 
    79       !!      Madec et al. 1988, ocean modelling, issue 78, 1-6. 
    80       !! 
    81       !! History : 
    82       !!        !  96-05  (G. Madec, M. Imbard, M. Guyon)  rewitting in 1 
    83       !!                  routine, without pointers, and with the same matrix 
    84       !!                  for sor and pcg, mpp exchange, and symmetric conditions 
    85       !!        !  96-07  (A. Weaver)  Euler forward step 
    86       !!        !  96-11  (A. Weaver)  correction to preconditioning: 
    87       !!        !  98-02  (M. Guyon)  FETI method 
    88       !!        !  98-05  (G. Roullet)  free surface 
    89       !!        !  97-09  (J.-M. Molines)  Open boundaries 
    90       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    91       !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
    92       !!   9.0  !  04-08  (C. Talandier)  New trends organization 
    93       !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
     93      !! References : Madec et al. 1988, ocean modelling, issue 78, 1-6. 
    9494      !!--------------------------------------------------------------------- 
    95       !! * Arguments 
    9695      INTEGER, INTENT( in  ) ::   kt       ! ocean time-step index 
    97       INTEGER, INTENT( out ) ::   kindic   ! solver flag, take a negative value 
    98       !                                    ! when the solver doesnot converge 
    99       !! * Local declarations 
     96      INTEGER, INTENT( out ) ::   kindic   ! solver flag (<0 when the solver does not converge) 
    10097      INTEGER ::   ji, jj, jk    ! dummy loop indices 
    10198      REAL(wp) ::  zbsfa, zgcx, z2dt 
     
    114111 
    115112         ! set to zero rigid-lid specific arrays 
    116          spgu(:,:) = 0.e0      ! surface pressure gradient (i-direction)  
    117          spgv(:,:) = 0.e0      ! surface pressure gradient (j-direction) 
    118       ENDIF 
    119  
    120       ! 0. Initializations: 
    121       ! ------------------- 
    122 # if defined key_obc 
    123       ! space index on boundary arrays 
    124       ib = 1 
    125       ibm = 2 
    126       ibm2 = 3 
    127       ! time index on boundary arrays 
    128       it = 1 
    129       itm = 2 
    130       itm2 = 3 
    131 # endif 
    132  
     113         spgu(:,:) = 0.e0                   ! surface pressure gradient (i-direction)  
     114         spgv(:,:) = 0.e0                   ! surface pressure gradient (j-direction) 
     115 
     116         CALL solver_init( nit000 )         ! Elliptic solver initialisation 
     117 
     118         ! read rigid lid arrays in restart file 
     119         CALL rl_rst( nit000, 'READ' )      ! read or initialize the following fields: 
     120         !                                  ! gcx, gcxb, bsfb, bsfn, bsfd 
     121      ENDIF 
     122 
     123      !  Vertically averaged momentum trend 
     124      ! ------------------------------------ 
    133125      !                                                ! =============== 
    134126      DO jj = 2, jpjm1                                 !  Vertical slab 
    135127         !                                             ! =============== 
    136  
    137          ! 1. Vertically averaged momentum trend 
    138          ! ------------------------------------- 
    139          ! initialization to zero 
    140          spgu(:,jj) = 0. 
     128          
     129         spgu(:,jj) = 0.                          ! initialization to zero 
    141130         spgv(:,jj) = 0. 
    142          ! vertical sum 
    143          DO jk = 1, jpk 
     131         DO jk = 1, jpk                           ! vertical sum 
    144132            DO ji = 2, jpim1 
    145133               spgu(ji,jj) = spgu(ji,jj) + ua(ji,jj,jk) * fse3u(ji,jj,jk) * umask(ji,jj,jk) 
     
    147135            END DO  
    148136         END DO  
    149          ! divide by the depth 
    150          spgu(:,jj) = spgu(:,jj) * hur(:,jj) 
     137         spgu(:,jj) = spgu(:,jj) * hur(:,jj)      ! divide by the depth  
    151138         spgv(:,jj) = spgv(:,jj) * hvr(:,jj) 
    152139 
     
    155142      !                                                ! =============== 
    156143 
    157       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    158  
    159144      ! Boundary conditions on (spgu,spgv) 
    160145      CALL lbc_lnk( spgu, 'U', -1. ) 
    161146      CALL lbc_lnk( spgv, 'V', -1. ) 
    162147 
    163       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    164  
    165       ! 2. Barotropic streamfunction trend (bsfd) 
     148      !  Barotropic streamfunction trend (bsfd) 
    166149      ! ---------------------------------- 
    167  
    168       ! Curl of the vertically averaged velocity 
    169       DO jj = 2, jpjm1 
     150      DO jj = 2, jpjm1                            ! Curl of the vertically averaged velocity  
    170151         DO ji = 2, jpim1 
    171152            gcb(ji,jj) = -gcdprc(ji,jj)   & 
    172                        *(  ( e2v(ji+1,jj  )*spgv(ji+1,jj  ) - e2v(ji,jj)*spgv(ji,jj) )   & 
    173                           -( e1u(ji  ,jj+1)*spgu(ji  ,jj+1) - e1u(ji,jj)*spgu(ji,jj) )   )  
     153               &       *(  ( e2v(ji+1,jj  )*spgv(ji+1,jj  ) - e2v(ji,jj)*spgv(ji,jj) )   & 
     154               &          -( e1u(ji  ,jj+1)*spgu(ji  ,jj+1) - e1u(ji,jj)*spgu(ji,jj) )   )  
    174155         END DO 
    175156      END DO 
    176157 
    177158# if defined key_obc 
    178       ! Open boundary contribution 
    179       DO jj = 2, jpjm1 
     159      DO jj = 2, jpjm1                            ! Open boundary contribution  
    180160         DO ji = 2, jpim1 
    181161           gcb(ji,jj) = gcb(ji,jj) - gcdprc(ji,jj) * gcbob(ji,jj) 
     
    198178      ! applied the lateral boundary conditions 
    199179      IF( nsolv == 4)   CALL lbc_lnk_e( gcb, c_solver_pt, 1. )    
    200  
    201       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    202180 
    203181      ! Relative precision (computation on one processor) 
     
    234212      ENDIF 
    235213 
    236  
    237214      ! bsf trend update 
    238215      ! ---------------- 
    239  
    240216      bsfd(1:nlci,1:nlcj) = gcx(1:nlci,1:nlcj) 
    241  
    242217       
    243218      ! update bsf trend with islands trend 
    244219      ! ----------------------------------- 
    245  
    246220      IF( lk_isl )   CALL isl_dyn_spg         ! update bsfd 
    247  
    248221 
    249222# if defined key_obc 
     
    337310      ! 4. Barotropic stream function and array swap 
    338311      ! -------------------------------------------- 
    339  
    340312      ! Leap-frog time scheme, time filter and array swap 
    341313      IF( neuler == 0 .AND. kt == nit000 ) THEN 
     
    362334 
    363335# if defined key_obc 
     336      ib   = 1      ! space index on boundary arrays 
     337      ibm  = 2 
     338      ibm2 = 3 
     339      it   = 1      ! time index on boundary arrays 
     340      itm  = 2 
     341      itm2 = 3 
     342 
    364343      ! Swap of boundary arrays 
    365344      IF( lp_obc_east ) THEN 
     
    499478      ENDIF 
    500479# endif 
    501       ! 
    502       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    503480       
    504481      !  add the surface pressure trend to the general trend 
    505482      ! ----------------------------------------------------- 
    506        
    507483      DO jj = 2, jpjm1 
    508  
    509484         ! update the surface pressure gradient with the barotropic trend 
    510485         DO ji = 2, jpim1 
     
    519494            END DO 
    520495         END DO 
    521  
    522       END DO 
     496      END DO 
     497 
     498      ! write rigid lid arrays in restart file 
     499      ! -------------------------------------- 
     500      IF( lrst_oce ) CALL rl_rst( kt, 'WRITE' ) 
    523501 
    524502   END SUBROUTINE dyn_spg_rl 
     503 
     504 
     505   SUBROUTINE rl_rst( kt, cdrw ) 
     506     !!--------------------------------------------------------------------- 
     507     !!                   ***  ROUTINE rl_rst  *** 
     508     !! 
     509     !! ** Purpose : Read or write rigid-lid arrays in ocean restart file 
     510     !!---------------------------------------------------------------------- 
     511     INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     512     CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     513     !!---------------------------------------------------------------------- 
     514     ! 
     515     IF( TRIM(cdrw) == 'READ' ) THEN 
     516        IF( iom_varid( numror, 'gcx' ) > 0 ) THEN 
     517     ! Caution : extra-hallow 
     518     ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
     519           CALL iom_get( numror, jpdom_local, 'gcx' , gcx (1:jpi,1:jpj) ) 
     520           CALL iom_get( numror, jpdom_local, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     521           CALL iom_get( numror, jpdom_local, 'bsfb', bsfb(:,:)         ) 
     522           CALL iom_get( numror, jpdom_local, 'bsfn', bsfn(:,:)         ) 
     523           CALL iom_get( numror, jpdom_local, 'bsfd', bsfd(:,:)         ) 
     524           IF( neuler == 0 ) THEN 
     525              gcxb(:,:) = gcx (:,:) 
     526              bsfb(:,:) = bsfn(:,:) 
     527           ENDIF 
     528        ELSE 
     529           gcx (:,:) = 0.e0 
     530           gcxb(:,:) = 0.e0 
     531           bsfb(:,:) = 0.e0 
     532           bsfn(:,:) = 0.e0 
     533           bsfd(:,:) = 0.e0 
     534        ENDIF 
     535     ELSEIF(  TRIM(cdrw) == 'WRITE' ) THEN 
     536        ! Caution : extra-hallow, gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
     537        CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 
     538        CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     539        CALL iom_rstput( kt, nitrst, numrow, 'bsfb', bsfb(:,:)         ) 
     540        CALL iom_rstput( kt, nitrst, numrow, 'bsfn', bsfn(:,:)         ) 
     541        CALL iom_rstput( kt, nitrst, numrow, 'bsfd', bsfd(:,:)         ) 
     542     ENDIF 
     543     ! 
     544   END SUBROUTINE rl_rst 
    525545 
    526546#else 
  • trunk/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r455 r508  
    44   !! Ocean dynamics:  surface pressure gradient trend 
    55   !!====================================================================== 
     6   !! History :   9.0  !  04-12  (L. Bessieres, G. Madec)  Original code 
     7   !!             " "  !  05-11  (V. Garnier, G. Madec)  optimization 
     8   !!             9.0  !  06-08  (S. Masson)  distributed restart using iom 
     9   !!--------------------------------------------------------------------- 
    610#if ( defined key_dynspg_ts && ! defined key_mpp_omp ) ||   defined key_esopa 
    711   !!---------------------------------------------------------------------- 
     
    913   !!   NOT 'key_mpp_omp'                          k-j-i loop (vector opt.) 
    1014   !!---------------------------------------------------------------------- 
     15   !!---------------------------------------------------------------------- 
    1116   !!   dyn_spg_ts  : compute surface pressure gradient trend using a time- 
    1217   !!                 splitting scheme and add to the general trend  
     18   !!   ts_rst      : read/write the time-splitting restart fields in the ocean restart file 
    1319   !!---------------------------------------------------------------------- 
    1420   !! * Modules used 
     
    2733   USE dynspg_oce      ! surface pressure gradient variables 
    2834   USE in_out_manager  ! I/O manager 
     35   USE iom 
     36   USE restart         ! only for lrst_oce 
    2937 
    3038   IMPLICIT NONE 
    3139   PRIVATE 
    3240 
    33    !! * Accessibility 
    3441   PUBLIC dyn_spg_ts  ! routine called by step.F90 
     42 
     43   REAL(wp), DIMENSION(jpi,jpj) ::  ftnw, ftne,   &  ! triad of coriolis parameter 
     44      &                             ftsw, ftse       ! (only used with een vorticity scheme) 
     45 
    3546 
    3647   !! * Substitutions 
     
    7485      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 
    7586      !! 
    76       !! References : 
    77       !!   Griffies et al., (2003): A technical guide to MOM4. NOAA/GFDL 
    78       !! 
    79       !! History : 
    80       !!   9.0  !  04-12  (L. Bessieres, G. Madec)  Original code 
    81       !!        !  05-11  (V. Garnier, G. Madec)  optimization 
     87      !! References : Griffies et al., (2003): A technical guide to MOM4. NOAA/GFDL 
    8288      !!--------------------------------------------------------------------- 
    83       !! * Arguments 
    8489      INTEGER, INTENT( in )  ::   kt           ! ocean time-step index 
    8590 
     
    97102         zsshb_e, zub_e, zvb_e,             &  !     "        " 
    98103         zun_e, zvn_e                          !     "        " 
    99       REAL(wp), DIMENSION(jpi,jpj),SAVE ::  & 
    100          ztnw, ztne, ztsw, ztse 
    101104      !!---------------------------------------------------------------------- 
    102105 
     
    109112 
    110113      IF( kt == nit000 ) THEN 
    111  
     114         ! 
    112115         IF(lwp) WRITE(numout,*) 
    113116         IF(lwp) WRITE(numout,*) 'dyn_spg_ts : surface pressure gradient trend' 
     
    115118         IF(lwp) WRITE(numout,*) ' Number of sub cycle in 1 time-step (2 rdt) : icycle = ', FLOOR( 2*rdt/rdtbt ) 
    116119 
    117          IF( .NOT. ln_rstart ) THEN 
    118             ! initialize barotropic specific arrays 
    119             sshb_b(:,:) = sshb(:,:) 
    120             sshn_b(:,:) = sshn(:,:) 
    121             un_b(:,:)   = 0.e0 
    122             vn_b(:,:)   = 0.e0 
    123             ! vertical sum 
    124             IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll 
    125                DO jk = 1, jpkm1 
    126                   DO ji = 1, jpij 
    127                      un_b(ji,1) = un_b(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk) 
    128                      vn_b(ji,1) = vn_b(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk) 
    129                   END DO 
    130                END DO 
    131             ELSE                             ! No  vector opt. 
    132                DO jk = 1, jpkm1 
    133                   un_b(:,:) = un_b(:,:) + fse3u(:,:,jk) * un(:,:,jk) 
    134                   vn_b(:,:) = vn_b(:,:) + fse3v(:,:,jk) * vn(:,:,jk) 
    135                END DO 
    136             ENDIF 
    137          ENDIF 
     120         CALL ts_rst( nit000, 'READ' )   ! read or initialize the following fields: 
     121         !                               ! sshb, sshn, sshb_b, sshn_b, un_b, vn_b 
     122 
    138123         ssha_e(:,:) = sshn(:,:) 
    139124         ua_e(:,:)   = un_b(:,:) 
     
    141126 
    142127         IF( ln_dynvor_een ) THEN 
    143             ztne(1,:) = 0.e0   ;   ztnw(1,:) = 0.e0   ;   ztse(1,:) = 0.e0   ;   ztsw(1,:) = 0.e0 
     128            ftne(1,:) = 0.e0   ;   ftnw(1,:) = 0.e0   ;   ftse(1,:) = 0.e0   ;   ftsw(1,:) = 0.e0 
    144129            DO jj = 2, jpj 
    145130               DO ji = fs_2, jpi   ! vector opt. 
    146                   ztne(ji,jj) = ( ff(ji-1,jj  ) + ff(ji  ,jj  ) + ff(ji  ,jj-1) ) / 3. 
    147                   ztnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj  ) + ff(ji  ,jj  ) ) / 3. 
    148                   ztse(ji,jj) = ( ff(ji  ,jj  ) + ff(ji  ,jj-1) + ff(ji-1,jj-1) ) / 3. 
    149                   ztsw(ji,jj) = ( ff(ji  ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj  ) ) / 3. 
     131                  ftne(ji,jj) = ( ff(ji-1,jj  ) + ff(ji  ,jj  ) + ff(ji  ,jj-1) ) / 3. 
     132                  ftnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj  ) + ff(ji  ,jj  ) ) / 3. 
     133                  ftse(ji,jj) = ( ff(ji  ,jj  ) + ff(ji  ,jj-1) + ff(ji-1,jj-1) ) / 3. 
     134                  ftsw(ji,jj) = ( ff(ji  ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj  ) ) / 3. 
    150135               END DO 
    151136            END DO 
    152137         ENDIF 
    153  
     138         ! 
    154139      ENDIF 
    155      
     140 
    156141      ! Local constant initialization 
    157142      ! -------------------------------- 
     
    216201            END DO 
    217202         END DO 
    218  
     203         ! 
    219204      ELSEIF ( ln_dynvor_ens ) THEN                    ! enstrophy conserving scheme 
    220205         DO jj = 2, jpjm1 
     
    228213            END DO 
    229214         END DO 
    230  
     215         ! 
    231216      ELSEIF ( ln_dynvor_een ) THEN                    ! enstrophy and energy conserving scheme 
    232217         zfac25 = 0.25 
     
    241226            END DO 
    242227         END DO 
    243  
     228         ! 
    244229      ENDIF 
    245230 
     
    300285      DO jit = 1, icycle                                   !  sub-time-step loop  ! 
    301286         !                                                 ! ==================== ! 
    302  
    303287         z2dt_e = 2. * rdtbt 
    304288         IF ( jit == 1 )   z2dt_e = rdtbt 
     
    360344               END DO 
    361345            END DO 
    362  
     346            ! 
    363347         ELSEIF ( ln_dynvor_ens ) THEN                    ! enstrophy conserving scheme 
    364348            DO jj = 2, jpjm1 
     
    379363               END DO 
    380364            END DO 
    381  
     365            ! 
    382366         ELSEIF ( ln_dynvor_een ) THEN                    ! energy and enstrophy conserving scheme 
    383367            zfac25 = 0.25 
     
    397381               END DO 
    398382            END DO 
     383            !  
    399384         ENDIF 
    400385 
     
    504489      END DO 
    505490 
    506       IF(ln_ctl) THEN         ! print sum trends (used for debugging) 
    507          CALL prt_ctl(tab2d_1=sshn, clinfo1=' ssh      : ', mask1=tmask) 
     491      ! write filtered free surface arrays in restart file 
     492      ! -------------------------------------------------- 
     493      IF( lrst_oce )   CALL ts_rst( kt, 'WRITE' ) 
     494 
     495      ! print sum trends (used for debugging) 
     496      IF( ln_ctl )     CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh      : ', mask1=tmask ) 
     497      ! 
     498   END SUBROUTINE dyn_spg_ts 
     499 
     500 
     501   SUBROUTINE ts_rst( kt, cdrw ) 
     502      !!--------------------------------------------------------------------- 
     503      !!                   ***  ROUTINE ts_rst  *** 
     504      !! 
     505      !! ** Purpose : Read or write time-splitting arrays in restart file 
     506      !!---------------------------------------------------------------------- 
     507      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     508      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     509      ! 
     510      INTEGER ::  ji, jk        ! dummy loop indices 
     511      !!---------------------------------------------------------------------- 
     512      ! 
     513      IF( TRIM(cdrw) == 'READ' ) THEN 
     514         IF( iom_varid( numror, 'sshn' ) > 0 ) THEN 
     515            CALL iom_get( numror, jpdom_local, 'sshb'  , sshb(:,:)   ) 
     516            CALL iom_get( numror, jpdom_local, 'sshn'  , sshn(:,:)   ) 
     517            IF( neuler == 0 ) sshb(:,:) = sshn(:,:) 
     518         ELSE 
     519            sshb(:,:) = 0.e0 
     520            sshn(:,:) = 0.e0 
     521         ENDIF 
     522         IF( iom_varid( numror, 'sshn_b' ) > 0 ) THEN 
     523            CALL iom_get( numror, jpdom_local, 'sshb_b', sshb_b(:,:) )   ! free surface issued 
     524            CALL iom_get( numror, jpdom_local, 'sshn_b', sshn_b(:,:) )   ! from time-splitting loop 
     525            CALL iom_get( numror, jpdom_local, 'un_b'  , un_b  (:,:) )   ! horizontal transports issued 
     526            CALL iom_get( numror, jpdom_local, 'vn_b'  , vn_b  (:,:) )   ! from barotropic loop 
     527            IF( neuler == 0 ) sshb_b(:,:) = sshn_b(:,:) 
     528         ELSE 
     529            sshb_b(:,:) = sshb(:,:) 
     530            sshn_b(:,:) = sshn(:,:) 
     531            un_b  (:,:) = 0.e0 
     532            vn_b  (:,:) = 0.e0 
     533            ! vertical sum 
     534            IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll 
     535               DO jk = 1, jpkm1 
     536                  DO ji = 1, jpij 
     537                     un_b(ji,1) = un_b(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk) 
     538                     vn_b(ji,1) = vn_b(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk) 
     539                  END DO 
     540               END DO 
     541            ELSE                             ! No  vector opt. 
     542               DO jk = 1, jpkm1 
     543                  un_b(:,:) = un_b(:,:) + fse3u(:,:,jk) * un(:,:,jk) 
     544                  vn_b(:,:) = vn_b(:,:) + fse3v(:,:,jk) * vn(:,:,jk) 
     545               END DO 
     546            ENDIF 
     547         ENDIF 
     548      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     549         CALL iom_rstput( kt, nitrst, numrow, 'sshb'  , sshb  (:,:) ) 
     550         CALL iom_rstput( kt, nitrst, numrow, 'sshn'  , sshn  (:,:) ) 
     551         CALL iom_rstput( kt, nitrst, numrow, 'sshb_b', sshb_b(:,:) )   ! free surface issued 
     552         CALL iom_rstput( kt, nitrst, numrow, 'sshn_b', sshn_b(:,:) )   ! from barotropic loop 
     553         CALL iom_rstput( kt, nitrst, numrow, 'un_b'  , un_b  (:,:) )   ! horizontal transports issued 
     554         CALL iom_rstput( kt, nitrst, numrow, 'vn_b'  , vn_b  (:,:) )   ! from barotropic loop 
    508555      ENDIF 
    509        
    510    END SUBROUTINE dyn_spg_ts 
     556      ! 
     557   END SUBROUTINE ts_rst 
     558 
    511559#else 
    512560   !!---------------------------------------------------------------------- 
  • trunk/NEMO/OPA_SRC/SOL/solmat.F90

    r413 r508  
    44   !! solver       : construction of the matrix  
    55   !!====================================================================== 
     6   !! History :   1.0  !  88-04  (G. Madec)  Original code 
     7   !!                  !  93-03  (M. Guyon)  symetrical conditions 
     8   !!                  !  93-06  (M. Guyon)  suppress pointers 
     9   !!                  !  96-05  (G. Madec)  merge sor and pcg formulations 
     10   !!                  !  96-11  (A. Weaver)  correction to preconditioning 
     11   !!                  !  98-02  (M. Guyon)  FETI method 
     12   !!             8.5  !  02-08  (G. Madec)  F90: Free form 
     13   !!                  !  02-11  (C. Talandier, A-M. Treguier) Free surface & Open boundaries 
     14   !!             9.0  !  05-09  (R. Benshila)  add sol_exd for extra outer halo 
     15   !!             9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     16   !!             9.0  !  06-07  (S. Masson)  distributed restart using iom 
     17   !!---------------------------------------------------------------------- 
    618 
    719   !!---------------------------------------------------------------------- 
     
    2941   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    3042   !! $Header$  
    31    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    3244   !!---------------------------------------------------------------------- 
    3345 
     
    5567      !!              - gcdmat : preconditioning matrix (diagonal elements) 
    5668      !!              - gcdprc : inverse of the preconditioning matrix 
    57       !! 
    58       !! History : 
    59       !!   1.0  !  88-04  (G. Madec)  Original code 
    60       !!        !  91-11  (G. Madec) 
    61       !!        !  93-03  (M. Guyon)  symetrical conditions 
    62       !!        !  93-06  (M. Guyon)  suppress pointers 
    63       !!        !  96-05  (G. Madec)  merge sor and pcg formulations 
    64       !!        !  96-11  (A. Weaver)  correction to preconditioning 
    65       !!        !  98-02  (M. Guyon)  FETI method 
    66       !!   8.5  !  02-08  (G. Madec)  F90: Free form 
    67       !!        !  02-11  (C. Talandier, A-M. Treguier) Free surface & Open boundaries 
    68       !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    6969      !!---------------------------------------------------------------------- 
    7070      !! * Arguments 
  • trunk/NEMO/OPA_SRC/ZDF/zdftke.F90

    r474 r508  
    55   !!                 turbulent closure parameterization 
    66   !!===================================================================== 
     7   !! History :   6.0  !  91-03  (b. blanke)  Original code 
     8   !!             7.0  !  91-11  (G. Madec)   bug fix 
     9   !!             7.1  !  92-10  (G. Madec)   new mixing length and eav 
     10   !!             7.2  !  93-03  (M. Guyon)   symetrical conditions 
     11   !!             7.3  !  94-08  (G. Madec, M. Imbard)   npdl flag 
     12   !!             7.5  !  96-01  (G. Madec)   s-coordinates 
     13   !!             8.0  !  97-07  (G. Madec)   lbc 
     14   !!             8.1  !  99-01  (E. Stretta) new option for the mixing length 
     15   !!             8.5  !  02-06  (G. Madec) add zdf_tke_init routine 
     16   !!             8.5  !  02-08  (G. Madec)  ri_c and Free form, F90 
     17   !!             9.0  !  04-10  (C. Ethe )  1D configuration 
     18   !!             9.0  !  02-08  (G. Madec)  autotasking optimization 
     19   !!             9.0  !  06-07  (S. Masson)  distributed restart using iom 
     20   !!---------------------------------------------------------------------- 
    721#if defined key_zdftke   ||   defined key_esopa 
    822   !!---------------------------------------------------------------------- 
    9    !!   'key_zdftke'                                             TKE scheme 
     23   !!   'key_zdftke'                                   TKE vertical physics 
     24   !!---------------------------------------------------------------------- 
    1025   !!---------------------------------------------------------------------- 
    1126   !!   zdf_tke      : update momentum and tracer Kz from a tke scheme 
    1227   !!   zdf_tke_init : initialization, namelist read, and parameters control 
     28   !!   tke_rst      : read/write tke restart in ocean restart file 
    1329   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1530   USE oce             ! ocean dynamics and active tracers  
    1631   USE dom_oce         ! ocean space and time domain 
    1732   USE zdf_oce         ! ocean vertical physics 
    18    USE in_out_manager  ! I/O manager 
    19    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2033   USE phycst          ! physical constants 
    2134   USE taumod          ! surface stress 
     35   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2236   USE prtctl          ! Print control 
     37   USE in_out_manager  ! I/O manager 
     38   USE iom 
     39   USE restart         ! only for lrst_oce 
    2340 
    2441   IMPLICIT NONE 
    2542   PRIVATE 
    2643 
    27    !! * Routine accessibility 
    28    PUBLIC zdf_tke        ! routine called in step module 
    29    PUBLIC zdf_tke_init   ! routine called in zdftke_jki module 
    30  
    31    !! * Share Module variables 
    32    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .TRUE.    !: TKE vertical mixing flag 
    33    LOGICAL, PUBLIC ::         & !!: ** tke namelist (namtke) ** 
    34      ln_rstke = .FALSE.          !: =T restart with tke from a run without tke with  
    35      !                           !  a none zero initial value for en 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    37       en                         !: now turbulent kinetic energy 
    38  
    39    INTEGER, PUBLIC ::         & !!! ** tke namelist (namtke) ** 
    40       nitke = 50 ,            &  ! number of restart iterative loops 
    41       nmxl  =  2 ,            &  ! = 0/1/2/3 flag for the type of mixing length used 
    42       npdl  =  1 ,            &  ! = 0/1/2 flag on prandtl number on vert. eddy coeff. 
    43       nave  =  1 ,            &  ! = 0/1 flag for horizontal average on avt, avmu, avmv 
    44       navb  =  0                 ! = 0/1 flag for constant or profile background avt 
    45    REAL(wp), PUBLIC ::        & !!! ** tke namlist (namtke) ** 
    46       ediff = 0.1_wp       ,  &  ! coeff. for vertical eddy coef.; avt=ediff*mxl*sqrt(e) 
    47       ediss = 0.7_wp       ,  &  ! coef. of the Kolmogoroff dissipation  
    48       ebb   = 3.75_wp      ,  &  ! coef. of the surface input of tke 
    49       efave = 1._wp        ,  &  ! coef. for the tke vert. diff. coeff.; avtke=efave*avm 
    50       emin  = 0.7071e-6_wp ,  &  ! minimum value of tke (m2/s2) 
    51       emin0 = 1.e-4_wp     ,  &  ! surface minimum value of tke (m2/s2) 
    52       ri_c  = 2._wp / 9._wp      ! critic Richardson number 
    53    REAL(wp), PUBLIC ::        & 
    54       eboost                     ! multiplicative coeff of the shear product. 
    55  
    56    !! caution vectopt_memory change the solution (last digit of the solver stat) 
     44   PUBLIC   zdf_tke        ! routine called in step module 
     45   PUBLIC   zdf_tke_init   ! routine also called in zdftke_jki module 
     46   PUBLIC   tke_rst        ! routine also called in zdftke_jki module 
     47 
     48   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag 
     49   REAL(wp), PUBLIC                         ::   eboost              !: multiplicative coeff of the shear product. 
     50   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   en                  !: now turbulent kinetic energy 
    5751# if defined key_vectopt_memory 
    58    REAL(wp), DIMENSION(jpi,jpj,jpk), PUBLIC ::   & 
    59       etmean,    &  ! coefficient used for horizontal smoothing 
    60       eumean,    &  ! at t-, u- and v-points 
    61       evmean        ! 
     52   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etmean              !: coefficient used for horizontal smoothing 
     53   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   eumean, evmean      !: at t-, u- and v-points 
    6254# endif 
    6355 
     56   !! * Namelist (namtke) 
     57   LOGICAL , PUBLIC ::   ln_rstke = .FALSE.         !: =T restart with tke from a run without tke with  
     58     !                                              !  a none zero initial value for en 
     59   INTEGER , PUBLIC ::   nitke = 50 ,            &  !: number of restart iterative loops 
     60      &                  nmxl  =  2 ,            &  !: = 0/1/2/3 flag for the type of mixing length used 
     61      &                  npdl  =  1 ,            &  !: = 0/1/2 flag on prandtl number on vert. eddy coeff. 
     62      &                  nave  =  1 ,            &  !: = 0/1 flag for horizontal average on avt, avmu, avmv 
     63      &                  navb  =  0                 !: = 0/1 flag for constant or profile background avt 
     64   REAL(wp), PUBLIC ::   ediff = 0.1_wp       ,  &  !: coeff. for vertical eddy coef.; avt=ediff*mxl*sqrt(e) 
     65      &                  ediss = 0.7_wp       ,  &  !: coef. of the Kolmogoroff dissipation  
     66      &                  ebb   = 3.75_wp      ,  &  !: coef. of the surface input of tke 
     67      &                  efave = 1._wp        ,  &  !: coef. for the tke vert. diff. coeff.; avtke=efave*avm 
     68      &                  emin  = 0.7071e-6_wp ,  &  !: minimum value of tke (m2/s2) 
     69      &                  emin0 = 1.e-4_wp     ,  &  !: surface minimum value of tke (m2/s2) 
     70      &                  ri_c  = 2._wp / 9._wp      !: critic Richardson number 
     71   NAMELIST/namtke/ ln_rstke, ediff, ediss, ebb, efave, emin, emin0,   & 
     72      &             ri_c, nitke, nmxl, npdl, nave, navb 
     73 
    6474# if defined key_cfg_1d 
    65    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &    
    66       e_dis,    &   ! dissipation turbulent lengh scale 
    67       e_mix,    &   ! mixing turbulent lengh scale 
    68       e_pdl,    &   ! prandl number 
    69       e_ric         ! local Richardson number 
     75   !                                                                   ! 1D cfg only 
     76   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_dis, e_mix,      &  ! dissipation and mixing turbulent lengh scales 
     77      &                                          e_pdl, e_ric          ! prandl and local Richardson numbers 
    7078#endif 
    7179 
     
    7482#  include "vectopt_loop_substitute.h90" 
    7583   !!---------------------------------------------------------------------- 
    76    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     84   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     85   !! $Header$  
     86   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7787   !!---------------------------------------------------------------------- 
    7888 
    7989CONTAINS 
    8090 
    81    SUBROUTINE zdf_tke ( kt ) 
     91   SUBROUTINE zdf_tke( kt ) 
    8292      !!---------------------------------------------------------------------- 
    8393      !!                   ***  ROUTINE zdf_tke  *** 
     
    136146      !!                update avt, avmu, avmv (before vertical eddy coef.) 
    137147      !! 
    138       !! References : 
    139       !!      Gaspar et al., jgr, 95, 1990, 
    140       !!      Blanke and Delecluse, jpo, 1991 
    141       !! History : 
    142       !!   6.0  !  91-03  (b. blanke)  Original code 
    143       !!   7.0  !  91-11  (G. Madec)   bug fix 
    144       !!   7.1  !  92-10  (G. Madec)   new mixing length and eav 
    145       !!   7.2  !  93-03  (M. Guyon)   symetrical conditions 
    146       !!   7.3  !  94-08  (G. Madec, M. Imbard)   npdl flag 
    147       !!   7.5  !  96-01  (G. Madec)   s-coordinates 
    148       !!   8.0  !  97-07  (G. Madec)   lbc 
    149       !!   8.1  !  99-01  (E. Stretta) new option for the mixing length 
    150       !!   8.5  !  02-08  (G. Madec)  ri_c and Free form, F90 
    151       !!   9.0  !  04-10  (C. Ethe )  1D configuration 
     148      !! References : Gaspar et al., jgr, 95, 1990, 
     149      !!              Blanke and Delecluse, jpo, 1991 
    152150      !!---------------------------------------------------------------------- 
    153       !! * Modules used 
    154151      USE oce     , zwd   => ua,  &  ! use ua as workspace 
    155152         &          zmxlm => ta,  &  ! use ta as workspace 
    156153         &          zmxld => sa      ! use sa as workspace 
    157  
    158       !! * arguments 
    159       INTEGER, INTENT( in  ) ::   kt ! ocean time step 
    160  
    161       !! * local declarations 
    162       INTEGER ::   ji, jj, jk        ! dummy loop arguments 
    163       REAL(wp) ::   & 
    164          zmlmin, zbbrau,          &  ! temporary scalars 
    165          zfact1, zfact2, zfact3,  &  ! 
    166          zrn2, zesurf,            &  ! 
    167          ztx2, zty2, zav,         &  ! 
    168          zcoef, zcof, zsh2,       &  ! 
    169          zdku, zdkv, zpdl, zri,   &  ! 
    170          zsqen, zesh2,            &  ! 
    171          zemxl, zemlm, zemlp 
     154      ! 
     155      INTEGER, INTENT(in) ::   kt ! ocean time step 
     156      ! 
     157      INTEGER  ::   ji, jj, jk                  ! dummy loop arguments 
     158      REAL(wp) ::   zmlmin, zbbrau,          &  ! temporary scalars 
     159         &          zfact1, zfact2, zfact3,  &  ! 
     160         &          zrn2, zesurf,            &  ! 
     161         &          ztx2, zty2, zav,         &  ! 
     162         &          zcoef, zcof, zsh2,       &  ! 
     163         &          zdku, zdkv, zpdl, zri,   &  ! 
     164         &          zsqen, zesh2,            &  ! 
     165         &          zemxl, zemlm, zemlp 
    172166      !!-------------------------------------------------------------------- 
    173167 
    174       ! Initialization (first time-step only) 
    175       ! -------------- 
    176       IF( kt == nit000  )   CALL zdf_tke_init 
    177  
    178       ! Local constant initialization 
     168      IF( kt == nit000  )   CALL zdf_tke_init      ! Initialization (first time-step only) 
     169 
     170      !                                            ! Local constant initialization 
    179171      zmlmin = 1.e-8 
    180172      zbbrau =  .5 * ebb / rau0 
     
    183175      zfact3 = 0.5 * rdt * ediss 
    184176 
    185  
    186177      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    187178      ! I.  Mixing length 
    188179      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    189  
    190180 
    191181      ! Buoyancy length scale: l=sqrt(2*e/n**2) 
     
    204194         END DO 
    205195      END DO 
    206  
    207196 
    208197      ! Physical limits for the mixing length 
     
    291280# endif 
    292281 
    293  
    294282      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    295283      ! II  Tubulent kinetic energy time stepping 
    296284      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    297  
    298285 
    299286      ! 1. Vertical eddy viscosity on tke (put in zmxlm) and first estimate of avt 
     
    475462      CALL lbc_lnk( en , 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. ) 
    476463 
    477  
    478464      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    479465      ! III.  Before vertical eddy vicosity and diffusivity coefficients 
     
    601587      ! ------------------------------===== 
    602588      CALL lbc_lnk( avt, 'W', 1. ) 
     589 
     590      ! write en in restart file 
     591      ! ------------------------ 
     592      IF( lrst_oce )   CALL tke_rst( kt, 'WRITE' ) 
    603593 
    604594      IF(ln_ctl) THEN 
     
    624614      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter 
    625615      !! 
    626       !! history : 
    627       !!  8.5  ! 02-06 (G. Madec) original code 
    628616      !!---------------------------------------------------------------------- 
    629       !! * Module used 
    630617      USE dynzdf_exp 
    631618      USE trazdf_exp 
    632  
    633       !! * local declarations 
    634       !! caution vectopt_memory change the solution (last digit of the solver stat) 
     619      ! 
    635620# if defined key_vectopt_memory 
    636       INTEGER ::   ji, jj, jk, jit   ! dummy loop indices 
     621      ! caution vectopt_memory change the solution (last digit of the solver stat) 
     622      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    637623# else 
    638       INTEGER ::           jk, jit   ! dummy loop indices 
     624      INTEGER ::           jk   ! dummy loop indices 
    639625# endif 
    640  
    641       NAMELIST/namtke/ ln_rstke, ediff, ediss, ebb, efave, emin, emin0,   & 
    642          ri_c, nitke, nmxl, npdl, nave, navb 
    643626      !!---------------------------------------------------------------------- 
    644627 
     
    681664      ! Check nmxl and npdl values 
    682665      IF( nmxl < 0 .OR. nmxl > 3 ) CALL ctl_stop( '          bad flag: nmxl is < 0 or > 3 ' ) 
    683       IF ( npdl < 0 .OR. npdl > 1 ) CALL ctl_stop( '          bad flag: npdl is < 0 or > 1 ' ) 
     666      IF( npdl < 0 .OR. npdl > 1 ) CALL ctl_stop( '          bad flag: npdl is < 0 or > 1 ' ) 
    684667 
    685668      ! Horizontal average : initialization of weighting arrays  
     
    691674         IF(lwp) WRITE(numout,*) '          no horizontal average on avt, avmu, avmv' 
    692675         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !' 
    693 !! caution vectopt_memory change the solution (last digit of the solver stat) 
    694676# if defined key_vectopt_memory 
     677         ! caution vectopt_memory change the solution (last digit of the solver stat) 
    695678         ! weighting mean arrays etmean, eumean and evmean 
    696679         !           ( 1  1 )                                          ( 1 ) 
     
    720703      CASE ( 1 )                ! horizontal average  
    721704         IF(lwp) WRITE(numout,*) '          horizontal average on avt, avmu, avmv' 
    722 !! caution vectopt_memory change the solution (last digit of the solver stat) 
    723705# if defined key_vectopt_memory 
     706         ! caution vectopt_memory change the solution (last digit of the solver stat) 
    724707         ! weighting mean arrays etmean, eumean and evmean 
    725708         !           ( 1  1 )              ( 1/2  1/2 )             ( 1/2  1  1/2 ) 
     
    790773 
    791774 
    792       ! Initialization of turbulent kinetic energy ( en ) 
     775      ! read or initialize turbulent kinetic energy ( en ) 
    793776      ! ------------------------------------------------- 
    794       IF( ln_rstart ) THEN 
    795          ! no en field in the restart file, en set by iterative loop 
    796          IF( ln_rstke ) THEN 
    797             en (:,:,:) = emin * tmask(:,:,:) 
    798             DO jit = 2, nitke+1 
    799                CALL zdf_tke( jit ) 
    800             END DO 
    801          ENDIF 
    802          ! otherwise en is already read in dtrlec called by inidtr 
    803       ELSE 
    804          ! no restart: en set to emin 
    805          en(:,:,:) = emin * tmask(:,:,:) 
    806       ENDIF 
    807  
     777      CALL tke_rst( nit000, 'READ' ) 
     778      ! 
    808779   END SUBROUTINE zdf_tke_init 
     780 
     781 
     782   SUBROUTINE tke_rst( kt, cdrw ) 
     783     !!--------------------------------------------------------------------- 
     784     !!                   ***  ROUTINE ts_rst  *** 
     785     !!                      
     786     !! ** Purpose : Read or write filtered free surface arrays in restart file 
     787     !! 
     788     !! ** Method  :  
     789     !! 
     790     !!---------------------------------------------------------------------- 
     791     INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     792     CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     793     ! 
     794     INTEGER ::   jit   ! dummy loop indices 
     795     !!---------------------------------------------------------------------- 
     796     ! 
     797     IF( TRIM(cdrw) == 'READ' ) THEN 
     798        IF( ln_rstart ) THEN 
     799           IF( iom_varid( numror, 'en' ) > 0 .AND. .NOT.(ln_rstke) ) THEN  
     800              CALL iom_get( numror, jpdom_local, 'en', en ) 
     801           ELSE 
     802              IF(lwp .AND. iom_varid(numror,'en') > 0 ) WRITE(numout,*) ' ===>>>> : previous run without tke scheme' 
     803              IF(lwp .AND. ln_rstke ) WRITE(numout,*) ' ===>>>> : We do not use en from the restart file' 
     804              IF(lwp) WRITE(numout,*) ' ===>>>> : en set by iterative loop' 
     805              IF(lwp) WRITE(numout,*) ' =======             =========' 
     806              en (:,:,:) = emin * tmask(:,:,:) 
     807              DO jit = 2, nitke+1 
     808                 CALL zdf_tke( jit ) 
     809              END DO 
     810           ENDIF 
     811        ELSE 
     812           en(:,:,:) = emin * tmask(:,:,:)      ! no restart: en set to emin 
     813        ENDIF 
     814     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     815        CALL iom_rstput( kt, nitrst, numrow, 'en', en ) 
     816     ENDIF 
     817     ! 
     818   END SUBROUTINE tke_rst 
    809819 
    810820#else 
     
    812822   !!   Dummy module :                                        NO TKE scheme 
    813823   !!---------------------------------------------------------------------- 
    814    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag 
     824   PUBLIC, LOGICAL, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag 
    815825CONTAINS 
    816826   SUBROUTINE zdf_tke( kt )          ! Empty routine 
  • trunk/NEMO/OPA_SRC/ZDF/zdftke_jki.F90

    r463 r508  
    55   !!                 turbulent closure parameterization 
    66   !!===================================================================== 
     7   !! History : 
     8   !!   9.0  !  02-08  (G. Madec)  autotasking optimization 
     9   !!---------------------------------------------------------------------- 
    710#if defined key_zdftke   ||   defined key_esopa 
    811   !!---------------------------------------------------------------------- 
     
    2326   USE taumod          ! surface stress 
    2427   USE prtctl          ! Print control 
     28   USE restart         ! only for lrst_oce 
    2529 
    2630   IMPLICIT NONE 
     
    99103      !!      Gaspar et al., jgr, 95, 1990, 
    100104      !!      Blanke and Delecluse, jpo, 1991 
    101       !! History : 
    102       !!   9.0  !  02-08  (G. Madec)  autotasking optimization 
    103105      !!---------------------------------------------------------------------- 
    104106      !! * Modules used 
     
    518520      CALL lbc_lnk( avt, 'W', 1. ) 
    519521 
     522      ! write en in restart file 
     523      ! ------------------------ 
     524      IF( lrst_oce )   CALL tke_rst( kt, 'WRITE' ) 
     525 
    520526      IF(ln_ctl) THEN 
    521527         CALL prt_ctl(tab3d_1=en  , clinfo1=' tke  - e: ', tab3d_2=avt , clinfo2=' t: ', ovlap=1, kdim=jpk) 
  • trunk/NEMO/OPA_SRC/in_out_manager.F90

    r472 r508  
    11MODULE in_out_manager    
     2   !!====================================================================== 
     3   !!                       ***  MODULE  in_out_manager  *** 
     4   !! Ocean physics:  vertical mixing coefficient compute from the tke  
     5   !!                 turbulent closure parameterization 
     6   !!===================================================================== 
     7   !! History :   8.5  !  02-06  (G. Madec)  original code 
     8   !!             9.0  !  06-07  (S. Masson)  iom, add ctl_stop, ctl_warn 
     9   !!---------------------------------------------------------------------- 
    210 
    3    USE lib_print         ! formated print library 
     11   !!---------------------------------------------------------------------- 
     12   !!   ctl_stop   : update momentum and tracer Kz from a tke scheme 
     13   !!   ctl_warn   : initialization, namelist read, and parameters control 
     14   !!---------------------------------------------------------------------- 
    415   USE par_kind 
    516   USE par_oce 
     17   USE lib_print         ! formated print library 
    618 
    719   PUBLIC 
    820 
    921   !!---------------------------------------------------------------------- 
    10    !! namelist parameters 
    11    !! ------------------------------------- 
    12    ! namrun:  parameters of the run 
    13    CHARACTER (len=16) ::    &   !: 
    14       cexper = "exp0"           !: experiment name used for output filename 
    15     
    16    LOGICAL ::   &              !!: * namelist namrun * 
    17       ln_rstart = .FALSE. ,  &  !: start from (F) rest or (T) a restart file 
    18       ln_ctl    = .FALSE.       !: run control for debugging 
    19     
    20    INTEGER ::                & !!: * namelist namrun * 
    21       no     = 0        ,    &  !: job number 
    22       nrstdt = 0        ,    &  !: control of the time step (0, 1 or 2) 
    23       nit000 = 1        ,    &  !: index of the first time step 
    24       nitend = 10       ,    &  !: index of the last time step 
    25       ndate0 = 961115   ,    &  !: initial calendar date aammjj 
    26       nleapy = 0        ,    &  !: Leap year calendar flag (0/1 or 30) 
    27       ninist = 0        ,    &  !: initial state output flag (0/1) 
    28       nbench = 0                !: benchmark parameter (0/1) 
     22   !!                   namrun namelist parameters 
     23   !!---------------------------------------------------------------------- 
     24   CHARACTER (len=16) ::   cexper    = "exp0"        !: experiment name used for output filename 
     25   LOGICAL            ::   ln_rstart = .FALSE. ,  &  !: start from (F) rest or (T) a restart file 
     26      &                    ln_ctl    = .FALSE.       !: run control for debugging 
     27   INTEGER            ::   no     = 0        ,    &  !: job number 
     28      &                    nrstdt = 0        ,    &  !: control of the time step (0, 1 or 2) 
     29      &                    nit000 = 1        ,    &  !: index of the first time step 
     30      &                    nitend = 10       ,    &  !: index of the last time step 
     31      &                    ndate0 = 961115   ,    &  !: initial calendar date aammjj 
     32      &                    nleapy = 0        ,    &  !: Leap year calendar flag (0/1 or 30) 
     33      &                    ninist = 0        ,    &  !: initial state output flag (0/1) 
     34      &                    nbench = 0                !: benchmark parameter (0/1) 
    2935    
    3036   !!---------------------------------------------------------------------- 
    31    !! output monitoring 
    32    !! ----------------------------------- 
    33  
    34    INTEGER ::                &  !: 
    35       nstock =   10 ,        &  !: restart file frequency 
    36       nprint =    0 ,        &  !: level of print (0 no print) 
    37       nwrite =   10 ,        &  !: restart file frequency 
    38       nictls =    0 ,        &  !: Start i indice for the SUM control 
    39       nictle =    0 ,        &  !: End   i indice for the SUM control 
    40       njctls =    0 ,        &  !: Start j indice for the SUM control 
    41       njctle =    0 ,        &  !: End   j indice for the SUM control 
    42       isplt  =    1 ,        &  !: number of processors following i 
    43       jsplt  =    1 ,        &  !: number of processors following j 
    44       ijsplt =    1             !: nb of local domain = nb of processors 
     37   !!                    output monitoring 
     38   !!---------------------------------------------------------------------- 
     39   INTEGER ::   nstock =   10 ,        &  !: restart file frequency 
     40      &         nprint =    0 ,        &  !: level of print (0 no print) 
     41      &         nwrite =   10 ,        &  !: restart file frequency 
     42      &         nictls =    0 ,        &  !: Start i indice for the SUM control 
     43      &         nictle =    0 ,        &  !: End   i indice for the SUM control 
     44      &         njctls =    0 ,        &  !: Start j indice for the SUM control 
     45      &         njctle =    0 ,        &  !: End   j indice for the SUM control 
     46      &         isplt  =    1 ,        &  !: number of processors following i 
     47      &         jsplt  =    1 ,        &  !: number of processors following j 
     48      &         ijsplt =    1             !: nb of local domain = nb of processors 
    4549 
    4650   !!---------------------------------------------------------------------- 
    47    !! logical units 
    48    !! ------------------------------ 
    49    INTEGER ::                &  !: 
    50       numstp     =  1 ,      &  !: logical unit for time step 
    51       numout     =  2 ,      &  !: logical unit for output print 
    52       numnam     =  3 ,      &  !: logical unit for namelist 
    53       numnam_ice =  4 ,      &  !: logical unit for ice namelist 
    54       numevo_ice = 17 ,      &  !: logical unit for ice variables (temp. evolution) 
    55       numice_dmp = 18 ,      &  !: logical unit for ice variables (damping) 
    56       numsol     = 25 ,      &  !: logical unit for solver statistics 
    57       numwri     = 40 ,      &  !: logical unit for output write 
    58       numisp     = 41 ,      &  !: logical unit for island statistics 
    59       numgap     = 45 ,      &  !: logical unit for differences diagnostic 
    60       numbol     = 67 ,      &  !: logical unit for "bol" diagnostics 
    61       numptr     = 68 ,      &  !: logical unit for Poleward TRansports 
    62       numflo     = 69           !: logical unit for drifting floats 
    63       !                         !: * coupled units 
     51   !!                        logical units 
     52   !!---------------------------------------------------------------------- 
     53   INTEGER ::   numstp     =  1 ,      &  !: logical unit for time step 
     54      &         numout     =  2 ,      &  !: logical unit for output print 
     55      &         numnam     =  3 ,      &  !: logical unit for namelist 
     56      &         numnam_ice =  4 ,      &  !: logical unit for ice namelist 
     57      &         numevo_ice = 17 ,      &  !: logical unit for ice variables (temp. evolution) 
     58      &         numsol     = 25 ,      &  !: logical unit for solver statistics 
     59      &         numwri     = 40 ,      &  !: logical unit for output write 
     60      &         numisp     = 41 ,      &  !: logical unit for island statistics 
     61      &         numgap     = 45 ,      &  !: logical unit for differences diagnostic 
     62      &         numbol     = 67 ,      &  !: logical unit for "bol" diagnostics 
     63      &         numptr     = 68 ,      &  !: logical unit for Poleward TRansports 
     64      &         numflo     = 69           !: logical unit for drifting floats 
    6465 
    6566   !!---------------------------------------------------------------------- 
     
    6768   !!---------------------------------------------------------------------- 
    6869    
    69    INTEGER ::                &  !: 
    70       nstop = 0 ,            &  !: e r r o r  flag (=number of reason for a 
    71       !                         !                   prematurely stop the run) 
    72       nwarn = 0                 !: w a r n i n g  flag (=number of warning 
    73       !                         !                       found during the run) 
    74  
    75     
    76    CHARACTER(LEN=100) :: ctmp1, ctmp2, ctmp3    ! temporary character 
    77    CHARACTER (len=64) ::        &                                                    !: 
    78       cform_err="(/,' ===>>> : E R R O R',     /,'         ===========',/)"    ,   & !: 
    79       cform_war="(/,' ===>>> : W A R N I N G', /,'         ===============',/)"      !: 
    80    LOGICAL ::   &               !: 
    81       lwp                ,   &  !: boolean : true on the 1st processor only 
    82       lsp_area = .TRUE.         !: to make a control print over a specific area 
     70   INTEGER            ::   nstop = 0 ,           &  !: error flag (=number of reason for a premature stop run) 
     71      &                    nwarn = 0                !: warning flag (=number of warning found during the run) 
     72   CHARACTER(LEN=100) ::   ctmp1, ctmp2, ctmp3      !: temporary character 
     73   CHARACTER (len=64) ::   cform_err="(/,' ===>>> : E R R O R',     /,'         ===========',/)"    ,   &  !: 
     74      &                    cform_war="(/,' ===>>> : W A R N I N G', /,'         ===============',/)"       !: 
     75   LOGICAL            ::   lwp               ,   &  !: boolean : true on the 1st processor only 
     76      &                    lsp_area = .TRUE.        !: to make a control print over a specific area 
    8377   !!---------------------------------------------------------------------- 
    8478   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    8579   !! $Header$  
    86    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     80   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    8781   !!---------------------------------------------------------------------- 
    8882 
    89  
    9083CONTAINS 
    91  
    9284 
    9385   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5,   & 
     
    9688      !!                  ***  ROUTINE  stop_opa  *** 
    9789      !! 
    98       !! ** Purpose : ??? 
    99       !! 
     90      !! ** Purpose : ??? blah blah.... 
    10091      !!----------------------------------------------------------------------- 
    101       CHARACTER(len=*),INTENT(in),OPTIONAL ::  cd1, cd2, cd3, cd4, cd5, cd6, cd7, cd8, cd9, cd10 
     92      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5,   & 
     93         &                                       cd6, cd7, cd8, cd9, cd10 
    10294      !!----------------------------------------------------------------------- 
    103        
     95      ! 
    10496      nstop = nstop + 1  
    10597      IF(lwp) THEN 
     
    117109      ENDIF 
    118110      CALL FLUSH(numout) 
    119  
     111      ! 
    120112   END SUBROUTINE ctl_stop 
    121113 
     
    124116      &                 cd6, cd7, cd8, cd9, cd10 ) 
    125117      !!----------------------------------------------------------------------- 
    126       !!                  ***  ROUTINE  stop_opa  *** 
     118      !!                  ***  ROUTINE  stop_warn  *** 
    127119      !! 
    128       !! ** Purpose : ??? 
    129       !! 
     120      !! ** Purpose : ???  blah blah.... 
    130121      !!----------------------------------------------------------------------- 
    131       CHARACTER(len=*),INTENT(in),OPTIONAL ::  cd1, cd2, cd3, cd4, cd5, cd6, cd7, cd8, cd9, cd10 
     122      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5,   & 
     123         &                                       cd6, cd7, cd8, cd9, cd10 
    132124      !!----------------------------------------------------------------------- 
    133        
     125      !  
    134126      nwarn = nwarn + 1  
    135127      IF(lwp) THEN 
     
    147139      ENDIF 
    148140      CALL FLUSH(numout) 
    149  
     141      ! 
    150142   END SUBROUTINE ctl_warn 
    151143 
     144   !!===================================================================== 
    152145END MODULE in_out_manager 
  • trunk/NEMO/OPA_SRC/iom.F90

    r485 r508  
    22   !!===================================================================== 
    33   !!                    ***  MODULE  iom *** 
    4    !! 
    54   !! Input/Output manager :  Library to read input files 
    6    !! 
    7    !! Ongoing work : This code is here to help discussions about I/O 
    8    !!                library in the NEMO system 
    95   !!==================================================================== 
     6   !! History :  9.0  ! 05 12  (J. Belier) Original code 
     7   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
     8   !!-------------------------------------------------------------------- 
     9   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
     10 
    1011   !!-------------------------------------------------------------------- 
    1112   !!   iom_open       : open a file read only 
    1213   !!   iom_close      : close a file or all files opened by iom 
    13    !!   iom_get        : read a field : interface to several routines 
     14   !!   iom_get        : read a field (interfaced to several routines) 
     15   !!   iom_gettime    : read the time axis cdvar in the file               !!gm : never call ?????? 
    1416   !!   iom_varid      : get the id of a variable in a file 
    15    !!   iom_get_gblatt : ??? 
     17   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    1618   !!-------------------------------------------------------------------- 
    17    !! History :  9.0  ! 05 12  (J. Belier) Original code 
    18    !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
    19    !!-------------------------------------------------------------------- 
    20    !! * Modules used 
    2119   USE in_out_manager  ! I/O manager 
    2220   USE dom_oce         ! ocean space and time domain 
    23    USE lbclnk          ! ??? 
    24    USE ioipsl          ! ??? 
     21   USE lbclnk          ! lateal boundary condition / mpp exchanges 
     22   USE ioipsl          ! IOIPSL library 
    2523 
    2624   IMPLICIT NONE 
    2725   PRIVATE 
    2826 
    29    PUBLIC iom_open, iom_close, iom_get, iom_varid, iom_get_gblatt 
    30  
    31    !! * Interfaces 
     27   PUBLIC iom_open, iom_close, iom_get, iom_varid, iom_rstput, iom_gettime 
     28 
    3229   INTERFACE iom_get 
    33       MODULE PROCEDURE iom_get_r_1d, iom_get_r_2d, iom_get_r_3d 
     30      MODULE PROCEDURE iom_get_r_0d, iom_get_r_1d, iom_get_r_2d, iom_get_r_3d 
    3431   END INTERFACE 
    35  
    36    !! * Share module variables 
    37    INTEGER, PARAMETER, PUBLIC ::        &  !: 
    38       jpdom_data                  = 1,  &  !: ( 1  :jpidta, 1  :jpjdta) 
    39       jpdom_global                = 2,  &  !: ( 1  :jpiglo, 1  :jpjglo) 
    40       jpdom_local                 = 3,  &  !: One of the 3 following cases 
    41       jpdom_local_full            = 4,  &  !: ( 1  :jpi   , 1  :jpi   ) 
    42       jpdom_local_noextra         = 5,  &  !: ( 1  :nlci  , 1  :nlcj  ) 
    43       jpdom_local_noovlap         = 6,  &  !: (nldi:nlei  ,nldj:nlej  ) 
    44       jpdom_unknown               = 7      !: No dimension checking 
    45  
    46    !! * Module variables 
    47    INTEGER, PARAMETER ::    & 
    48       jpmax_vars    = 50,   &  ! maximum number of variables in one file 
    49       jpmax_dims    =  5,   &  ! maximum number of dimensions for one variable 
    50       jpmax_digits  =  5       ! maximum number of digits in the file name to reference the cpu number 
    51   
     32   INTERFACE iom_rstput 
     33      MODULE PROCEDURE iom_rstput_0d, iom_rstput_1d, iom_rstput_2d, iom_rstput_3d 
     34   END INTERFACE 
     35 
     36   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpidta, 1  :jpjdta) 
     37   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo) 
     38   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases 
     39   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   ) 
     40   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  ) 
     41   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  ) 
     42   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking 
     43 
     44   INTEGER, PARAMETER ::   jpmax_vars   = 60,   &  ! maximum number of variables in one file 
     45      &                    jpmax_dims   =  4,   &  ! maximum number of dimensions for one variable 
     46      &                    jpmax_digits =  5       ! maximum number of digits for the cpu number in the file name 
    5247!$AGRIF_DO_NOT_TREAT 
    53    INTEGER :: iom_init = 0 
    54  
    55    TYPE :: flio_file 
     48   INTEGER ::   iom_init = 0 
     49   TYPE    ::   flio_file 
    5650      CHARACTER(LEN=240)                        ::   name     ! name of the file 
    57       INTEGER                                   ::   iopen    ! 1/0 is the file is open/not open 
     51      INTEGER                                   ::   iopen    ! 1(0) if the file is open(not open) 
    5852      INTEGER                                   ::   nvars    ! number of identified varibles in the file 
    5953      INTEGER                                   ::   iduld    ! id of the unlimited dimension 
    6054      CHARACTER(LEN=16), DIMENSION(jpmax_vars)  ::   cn_var   ! names of the variables 
    6155      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    ! number of dimensions of the variables 
    62       LOGICAL, DIMENSION(jpmax_vars)            ::   luld     ! variable including unlimited dimension 
    63       INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    ! size of the dimensions of the variables 
     56      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     ! variable using the unlimited dimension 
     57      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    ! size of variables dimensions  
    6458      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      ! scale_factor of the variables 
    6559      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      ! add_offset of the variables 
    6660   END TYPE flio_file 
    67    TYPE(flio_file), DIMENSION(flio_max_files)   :: iom_file ! array containing the info for all opened files 
     61   TYPE(flio_file), DIMENSION(flio_max_files)   ::   iom_file ! array containing the info for all opened files 
    6862!$AGRIF_END_DO_NOT_TREAT 
    6963 
     
    7670CONTAINS 
    7771 
    78    SUBROUTINE iom_open( cdname, knumfl, ldimg ) 
     72   SUBROUTINE iom_open( cdname, knumfl, ldwrt, kdom, ldimg ) 
    7973      !!--------------------------------------------------------------------- 
    8074      !!                   ***  SUBROUTINE  iom_open  *** 
    8175      !! 
    8276      !! ** Purpose :  open an input file read only (return 0 if not found) 
    83       !! 
    84       !! ** Method : 
    85       !! 
    8677      !!--------------------------------------------------------------------- 
    87       CHARACTER(len=*), INTENT(in )  ::   cdname   ! File name 
    88       INTEGER, INTENT(out)           ::   knumfl   ! Identifier of the opened file 
    89       LOGICAL, INTENT(in ), OPTIONAL ::   ldimg    ! flg to specify that we use dimg format 
    90  
    91       CHARACTER(LEN=100) :: clname   ! the name of the file based on cdname [[+clcpu]+clcpu] 
    92       CHARACTER(LEN=10) :: clsuffix  ! ".nc" or ".dimg" 
    93       CHARACTER(LEN=10) :: clcpu     ! the cpu number (max jpmax_digits digits) 
    94       LOGICAL :: llok                ! check the existence  
    95       INTEGER :: icnt                ! counter for digits in clcpu (max = jpmax_digits) 
     78      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name 
     79      INTEGER         , INTENT(  out)           ::   knumfl   ! Identifier of the opened file 
     80      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! read or write the file? 
     81      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written 
     82      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldimg    ! use dimg format? 
     83 
     84      CHARACTER(LEN=100)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
     85      CHARACTER(LEN=100)    ::   cltmpn    ! tempory name to store clname (in writting mode) 
     86      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg" 
     87      CHARACTER(LEN=10)     ::   clcpu     ! the cpu number (max jpmax_digits digits) 
     88      LOGICAL               ::   llok      ! check the existence  
     89      LOGICAL               ::   llwrt     !  
     90      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
     91      INTEGER               ::   iln, ils  ! lengths of character 
     92      INTEGER               ::   idom      ! type of domain 
     93      INTEGER               ::   ifliodom  ! model domain identifier (see flio_dom_set) 
     94      INTEGER, DIMENSION(2) ::   iszl      ! local number of points for x,y dimensions 
     95      INTEGER, DIMENSION(2) ::   ifst      ! position of first local point for x,y dimensions 
     96      INTEGER, DIMENSION(2) ::   ilst      ! position of last local point for x,y dimensions 
     97      INTEGER, DIMENSION(2) ::   ihst      ! start halo size for x,y dimensions 
     98      INTEGER, DIMENSION(2) ::   ihnd      ! end halo size for x,y dimensions 
    9699      !--------------------------------------------------------------------- 
    97  
    98       ! find the file 
     100      ! if iom_open is called for the first time: initialize iom_file(:)%iopen to 0 
     101      ! (could be done when defining iom_file in f95 but not in f90) 
     102      IF( iom_init == 0 ) THEN 
     103         iom_file(:)%iopen = 0 
     104         iom_init = 1 
     105      ENDIF 
     106      ! do we read or write the file? 
     107      ! ============= 
     108      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt 
     109      ELSE                        ;   llwrt = .FALSE. 
     110      ENDIF 
     111      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 
    99112      ! ============= 
    100113      clname   = trim(cdname) 
    101114#if defined key_agrif 
    102115      if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    103 #endif                 
     116#endif     
     117      ! which suffix should we use? 
    104118      clsuffix = ".nc" 
    105       IF( PRESENT(ldimg) ) THEN 
    106          IF ( ldimg ) clsuffix = ".dimg" 
    107       ENDIF 
    108       ! 
     119      IF( PRESENT(ldimg) ) THEN   ;   IF( ldimg )   clsuffix = ".dimg"   ;   ENDIF 
     120      ! Add the suffix if needed 
     121      iln = LEN_TRIM(clname) 
     122      ils = LEN_TRIM(clsuffix) 
     123      IF( iln <= ils) clname = clname(1:iln)//TRIM(clsuffix) 
     124      IF( clname(iln-ils+1:iln) /= TRIM(clsuffix) )   clname = clname(1:iln)//TRIM(clsuffix) 
     125      cltmpn = clname   ! store this name 
     126      ! try to find if the file to be opened already exist 
    109127      INQUIRE( FILE = clname, EXIST = llok ) 
    110       IF( .NOT.llok ) THEN                         ! try to complete the name with the suffix only 
    111          clname = TRIM(cdname)//TRIM(clsuffix) 
    112 #if defined key_agrif 
    113          if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    114 #endif                 
    115          INQUIRE( FILE = clname, EXIST = llok ) 
    116          IF( .NOT.llok ) THEN                      ! try to complete the name with both cpu number and suffix 
    117             WRITE(clcpu,*) narea-1 
    118             clcpu  = trim(adjustl(clcpu)) 
    119             clname = trim(cdname)//"_" 
    120 #if defined key_agrif 
    121             if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    122 #endif                 
    123             icnt = 0 
    124             INQUIRE( FILE = trim(clname)//trim(clcpu)//trim(clsuffix), EXIST = llok )  
    125             DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )   ! we try fifferent formats for the cpu number by adding 0 
    126                clname = trim(clname)//"0" 
    127                INQUIRE( FILE = trim(clname)//trim(clcpu)//trim(clsuffix), EXIST = llok ) 
    128                icnt = icnt + 1 
    129             END DO 
    130             IF( .NOT.llok ) THEN                   ! no way to find the files... 
    131                CALL ctl_stop( 'iom_open: file '//trim(clname)//'... not found' ) 
     128      IF( .NOT.llok ) THEN 
     129         ! we try to add the cpu number to the name 
     130         WRITE(clcpu,*) narea-1 
     131         clcpu  = TRIM(ADJUSTL(clcpu)) 
     132         iln = INDEX(clname,TRIM(clsuffix)) 
     133         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 
     134         icnt = 0 
     135         INQUIRE( FILE = clname, EXIST = llok )  
     136         ! we try different formats for the cpu number by adding 0 
     137         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits ) 
     138            clcpu  = "0"//trim(clcpu) 
     139            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 
     140            INQUIRE( FILE = clname, EXIST = llok ) 
     141            icnt = icnt + 1 
     142         END DO 
     143      ENDIF 
     144      ! 
     145      IF( llok ) THEN      ! Open the file 
     146         !                 ! ============= 
     147         IF( llwrt ) THEN  
     148            IF(lwp) WRITE(numout,*) '          iom_open ~~~  open existing file: '//TRIM(clname)//' in WRITE mode' 
     149            CALL flioopfd( TRIM(clname), knumfl, "WRITE" ) 
     150         ELSE 
     151            IF(lwp) WRITE(numout,*) '          iom_open ~~~  open existing file: '//TRIM(clname)//' in READ mode' 
     152            CALL flioopfd( TRIM(clname), knumfl ) 
     153         ENDIF 
     154      ELSE                 ! no way to find the file... 
     155         !                 ! ======================= 
     156         IF( llwrt ) THEN  
     157            ! file opened in write mode 
     158            ! the file does not exist, we must create it... 
     159            ! ============= 
     160            llok = .TRUE. 
     161            ! on which domain must the file be written?? 
     162            ! check the domain definition 
     163            idom = jpdom_local_noovlap   ! default definition 
     164            IF( PRESENT(kdom) )   idom = kdom 
     165            ! create the domain informations 
     166            ! ============= 
     167            SELECT CASE (idom) 
     168            CASE (jpdom_local_full) 
     169               iszl = (/ jpi             , jpj              /) 
     170               ifst = (/ nimpp           , njmpp            /) 
     171               ilst = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /) 
     172               ihst = (/ nldi - 1        , nldj - 1         /) 
     173               ihnd = (/ jpi - nlei      , jpj - nlej       /) 
     174            CASE (jpdom_local_noextra) 
     175               iszl = (/ nlci            , nlcj             /) 
     176               ifst = (/ nimpp           , njmpp            /) 
     177               ilst = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 
     178               ihst = (/ nldi - 1        , nldj - 1         /) 
     179               ihnd = (/ nlci - nlei     , nlcj - nlej      /) 
     180            CASE (jpdom_local_noovlap) 
     181               iszl = (/ nlei - nldi + 1 , nlej - nldj + 1  /) 
     182               ifst = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
     183               ilst = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
     184               ihst = (/ 0               , 0                /) 
     185               ihnd = (/ 0               , 0                /) 
     186            CASE DEFAULT 
     187               llok = .FALSE. 
     188               CALL ctl_stop( 'iom_open: wrong value of kdom, only jpdom_local* cases are accepted' ) 
     189            END SELECT 
     190            IF( llok ) THEN 
     191               CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/)   & 
     192                    &                  , iszl, ifst, ilst, ihst, ihnd, 'BOX', ifliodom )         
     193               ! create the file 
     194               ! ============= 
     195               ! Note that fliocrfd may change the value of clname (add the cpu number...) 
     196               clname = cltmpn   ! get back the file name without the cpu number in it 
     197               IF(lwp) WRITE(numout,*) '          iom_open ~~~  create new file: '//trim(clname)//' in WRITE mode' 
     198               CALL fliocrfd( clname, (/'x'    , 'y'    , 'z', 't'/)   & 
     199                    &               , (/iszl(1), iszl(2), jpk, -1 /)   & 
     200                    &               , knumfl, ifliodom ) 
    132201            ENDIF 
    133             clname = trim(clname)//trim(clcpu)//trim(clsuffix) 
     202         ELSE 
     203            ! the file is open for read-only, it must exist... 
     204            iln = INDEX( cltmpn,TRIM(clsuffix) ) 
     205            CALL ctl_stop( 'iom_open: file '//cltmpn(1:iln-1)//'* not found' ) 
    134206         ENDIF 
    135207      ENDIF 
    136  
    137       ! Open the file 
     208      ! start to fill the information of opened files 
    138209      ! ============= 
    139210      IF( llok ) THEN                          
    140          IF (lwp) WRITE(numout,*) 'iom_open ~~~  open file: '//trim(clname) 
    141          CALL flioopfd( trim(clname), knumfl ) 
    142          IF( iom_init == 0 ) THEN 
    143             iom_file(:)%iopen = 0 
    144             iom_init = 1 
    145          ENDIF 
    146211         iom_file(knumfl)%iopen      = 1 
    147212         iom_file(knumfl)%name       = TRIM(clname) 
     
    152217         ! does the file contain time axis (that must be unlimitted) ? 
    153218         CALL flioinqf( knumfl, id_uld = iom_file(knumfl)%iduld ) 
     219         IF(lwp) WRITE(numout,*) '                   ---> OK' 
    154220      ELSE 
    155          knumfl = 0 
    156       ENDIF 
    157    
     221         knumfl = 0      ! return error flag 
     222      ENDIF 
     223      ! 
    158224   END SUBROUTINE iom_open 
    159225 
     
    164230      !! 
    165231      !! ** Purpose : close an input file, or all files opened by iom 
    166       !! 
    167       !! ** Method : 
    168       !! 
    169232      !!-------------------------------------------------------------------- 
    170       INTEGER,INTENT(in), OPTIONAL ::   knumfl   ! Identifier of the file to be closed 
    171       !                                          ! If this argument is not present, 
    172       !                                          ! all the files opened by iom are closed. 
    173  
    174       INTEGER           ::   jf            ! dummy loop indices 
    175       INTEGER           ::   i_s, i_e      ! temporary integer 
     233      INTEGER, INTENT(in), OPTIONAL ::   knumfl   ! Identifier of the file to be closed 
     234      !                                           ! No argument : all the files opened by iom are closed 
     235 
     236      INTEGER ::   jf         ! dummy loop indices 
     237      INTEGER ::   i_s, i_e   ! temporary integer 
    176238      !--------------------------------------------------------------------- 
    177  
     239      ! 
    178240      IF( PRESENT(knumfl) ) THEN 
    179241         i_s = knumfl 
     
    183245         i_e = flio_max_files 
    184246      ENDIF 
    185       IF ( i_s > 0 ) THEN 
     247       
     248      IF( i_s > 0 ) THEN 
    186249         DO jf = i_s, i_e 
    187250            IF( iom_file(jf)%iopen > 0 ) THEN 
    188251               CALL flioclo( jf ) 
     252               IF(lwp) WRITE(numout,*) '          iom_close, close file: '//TRIM(iom_file(knumfl)%name)//' ok' 
    189253               iom_file(jf)%iopen      = 0 
    190254               iom_file(jf)%name       = 'NONE' 
     
    200264         END DO 
    201265      ENDIF 
    202            
     266      !     
    203267   END SUBROUTINE iom_close 
    204268  
    205269 
    206270   !!---------------------------------------------------------------------- 
    207    !!                   INTERFACE iom_u_getv 
     271   !!                   INTERFACE iom_get_123d 
    208272   !!---------------------------------------------------------------------- 
    209    SUBROUTINE iom_get_r_1d( knumfl, kdom , cdvar , pvar  ,   & 
    210       &                             ktime, kstart, kcount ) 
    211       INTEGER               , INTENT(in )           ::   knumfl    ! Identifier of the file 
    212       INTEGER               , INTENT(in )           ::   kdom      ! Type of domain to be read 
    213       CHARACTER(len=*)      , INTENT(in )           ::   cdvar     ! Name of the variable 
    214       REAL(wp), DIMENSION(:), INTENT(out)           ::   pvar      ! read field 
    215       INTEGER               , INTENT(in ) ,OPTIONAL ::   ktime     ! record number 
    216       INTEGER , DIMENSION(:), INTENT(in ), OPTIONAL ::   kstart    ! start position of the reading in each axis  
    217       INTEGER , DIMENSION(:), INTENT(in ), OPTIONAL ::   kcount    ! number of points to be read in each axis 
    218 ! 
    219       CHARACTER(LEN=100) :: clinfo                    ! info character 
    220 ! 
    221       clinfo = 'iom_get_r_1d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 
    222       IF( PRESENT(kstart) ) THEN 
    223          IF ( SIZE(kstart) /= 1 ) CALL ctl_stop( trim(clinfo), 'kstart must be a 1 element vector' ) 
    224       ENDIF 
    225       IF( PRESENT(kcount) ) THEN 
    226          IF ( SIZE(kcount) /= 1 ) CALL ctl_stop( trim(clinfo), 'kcount must be a 1 element vector' ) 
    227       ENDIF 
    228       IF ( knumfl > 0 ) CALL iom_u_getv( knumfl, kdom       , cdvar        , pv_r1d=pvar,   & 
    229            &                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     273   SUBROUTINE iom_get_r_0d( knumfl, cdvar, pvar ) 
     274      INTEGER         , INTENT(in   )                 ::   knumfl    ! Identifier of the file 
     275      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
     276      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field 
     277      ! 
     278      IF( knumfl > 0 .AND. iom_varid( knumfl, cdvar ) > 0 )   CALL fliogetv( knumfl, cdvar, pvar ) 
     279   END SUBROUTINE iom_get_r_0d 
     280 
     281   SUBROUTINE iom_get_r_1d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     282      INTEGER         , INTENT(in   )                         ::   knumfl    ! Identifier of the file 
     283      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     284      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     285      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     286      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     287      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     288      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
     289      ! 
     290      IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom       , cdvar        , pv_r1d=pvar,   & 
     291         &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
    230292   END SUBROUTINE iom_get_r_1d 
    231    SUBROUTINE iom_get_r_2d( knumfl, kdom , cdvar , pvar  ,   & 
    232       &                             ktime, kstart, kcount ) 
    233       INTEGER,INTENT(in) :: knumfl 
    234       INTEGER,INTENT(in) :: kdom 
    235       CHARACTER(len=*),INTENT(in) :: cdvar 
    236       REAL(wp),INTENT(out),DIMENSION(:,:) :: pvar 
    237       INTEGER,INTENT(in),OPTIONAL :: ktime 
    238       INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kstart 
    239       INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kcount 
    240 ! 
    241       CHARACTER(LEN=100) :: clinfo                    ! info character 
    242 ! 
    243       clinfo = 'iom_get_r_2d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 
    244       IF( PRESENT(kstart) ) THEN 
    245          IF ( size(kstart) /= 2 ) CALL ctl_stop(trim(clinfo), 'kstart must be a 2 element vector') 
    246       ENDIF 
    247       IF( PRESENT(kcount) ) THEN 
    248          IF ( size(kcount) /= 2 ) CALL ctl_stop(trim(clinfo), 'kcount must be a 2 element vector') 
    249       ENDIF 
    250       IF ( knumfl > 0 ) CALL iom_u_getv( knumfl, kdom       , cdvar        , pv_r2d=pvar,   & 
    251          &                                       ktime=ktime, kstart=kstart, kcount=kcount ) 
     293 
     294   SUBROUTINE iom_get_r_2d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     295      INTEGER         , INTENT(in   )                           ::   knumfl    ! Identifier of the file 
     296      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
     297      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
     298      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
     299      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
     300      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
     301      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
     302      ! 
     303      IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom       , cdvar        , pv_r2d=pvar,   & 
     304         &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
    252305   END SUBROUTINE iom_get_r_2d 
    253    SUBROUTINE iom_get_r_3d( knumfl, kdom , cdvar , pvar  ,   & 
    254       &                             ktime, kstart, kcount ) 
    255       INTEGER,INTENT(in) :: knumfl 
    256       INTEGER,INTENT(in) :: kdom 
    257       CHARACTER(len=*),INTENT(in) :: cdvar 
    258       REAL(wp),INTENT(out),DIMENSION(:,:,:) :: pvar 
    259       INTEGER,INTENT(in),OPTIONAL :: ktime 
    260       INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kstart 
    261       INTEGER,DIMENSION(:),INTENT(in),OPTIONAL :: kcount 
    262 ! 
    263       CHARACTER(LEN=100) :: clinfo                    ! info character 
    264 ! 
    265       clinfo = 'iom_get_r_3d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 
    266       IF ( PRESENT(kstart) ) THEN 
    267          IF ( size(kstart) /= 3 ) CALL ctl_stop(trim(clinfo), 'kstart must be a 3 element vector') 
    268       ENDIF 
    269       IF ( PRESENT(kcount) ) THEN 
    270          IF ( size(kcount) /= 3 ) CALL ctl_stop(trim(clinfo), 'kcount must be a 3 element vector') 
    271       ENDIF 
    272       IF ( knumfl > 0 ) CALL iom_u_getv( knumfl, kdom       , cdvar        , pv_r3d=pvar,   & 
    273         &                                   ktime=ktime, kstart=kstart, kcount=kcount ) 
     306 
     307   SUBROUTINE iom_get_r_3d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     308      INTEGER         , INTENT(in   )                             ::   knumfl    ! Identifier of the file 
     309      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
     310      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
     311      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
     312      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
     313      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
     314      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
     315      ! 
     316      IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom       , cdvar        , pv_r3d=pvar,   & 
     317         &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
    274318   END SUBROUTINE iom_get_r_3d 
    275319   !!---------------------------------------------------------------------- 
    276320 
    277  
    278    SUBROUTINE iom_u_getv( knumfl, kdom  , cdvar , & 
    279         &                   pv_r1d, pv_r2d, pv_r3d, & 
    280         &                   ktime , kstart, kcount ) 
     321   SUBROUTINE iom_get_123d( knumfl, kdom  , cdvar ,   & 
     322        &                   pv_r1d, pv_r2d, pv_r3d,   & 
     323        &                   ktime , kstart, kcount  ) 
    281324     !!----------------------------------------------------------------------- 
    282      !!                  ***  ROUTINE  iom_u_getv  *** 
     325     !!                  ***  ROUTINE  iom_get_123d  *** 
    283326     !! 
    284327     !! ** Purpose : read a 1D/2D/3D variable 
    285328     !! 
    286      !! ** Method : read ONE time step at each CALL 
    287      !! 
     329     !! ** Method : read ONE record at each CALL 
    288330     !!----------------------------------------------------------------------- 
    289      INTEGER,                      INTENT(in )           ::   knumfl     ! Identifier of the file 
    290      INTEGER,                      INTENT(in )           ::   kdom       ! Type of domain to be read 
    291      CHARACTER(len=*),             INTENT(in )           ::   cdvar      ! Name of the variable 
    292      REAL(wp), DIMENSION(:)      , INTENT(out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    293      REAL(wp), DIMENSION(:,:)    , INTENT(out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
    294      REAL(wp), DIMENSION(:,:,:)  , INTENT(out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
    295      INTEGER                     , INTENT(in ), OPTIONAL ::   ktime      ! record number 
    296      INTEGER , DIMENSION(:)      , INTENT(in ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
    297      INTEGER , DIMENSION(:)      , INTENT(in ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
    298  
    299      INTEGER                        :: jl            ! loop on number of dimension  
    300      INTEGER                        :: idom,    &    ! type of domain 
    301           &                            idvar,   &    ! id of the variable 
    302           &                            inbdim,  &    ! number of dimensions of the variable 
    303           &                            idmspc,  &    ! number of spatial dimensions  
    304           &                            itime,   &    ! record number 
    305           &                            istop         ! temporary value of nstop 
    306      INTEGER, DIMENSION(jpmax_dims) :: istart,  &    ! starting point to read for each axis 
    307           &                            icnt,    &    ! number of value to read along each axis  
    308           &                            idimsz        ! size of the dimensions of the variable 
    309      REAL(wp)                       :: zscf, zofs    ! sacle_factor and add_offset 
    310      INTEGER                        ::  itmp         ! temporary integer 
    311      CHARACTER(LEN=100)             :: clinfo        ! info character 
     331     INTEGER                    , INTENT(in  )           ::   knumfl     ! Identifier of the file 
     332     INTEGER                    , INTENT(in  )           ::   kdom       ! Type of domain to be read 
     333     CHARACTER(len=*)           , INTENT(in  )           ::   cdvar      ! Name of the variable 
     334     REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
     335     REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
     336     REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
     337     INTEGER                    , INTENT(in  ), OPTIONAL ::   ktime      ! record number 
     338     INTEGER , DIMENSION(:)     , INTENT(in  ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
     339     INTEGER , DIMENSION(:)     , INTENT(in  ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
     340     ! 
     341     INTEGER                        ::   jl          ! loop on number of dimension  
     342     INTEGER                        ::   idom,    &  ! type of domain 
     343          &                              idvar,   &  ! id of the variable 
     344          &                              inbdim,  &  ! number of dimensions of the variable 
     345          &                              idmspc,  &  ! number of spatial dimensions  
     346          &                              itime,   &  ! record number 
     347          &                              istop       ! temporary value of nstop 
     348     INTEGER, DIMENSION(jpmax_dims) ::   istart,  &  ! starting point to read for each axis 
     349          &                              icnt,    &  ! number of value to read along each axis  
     350          &                              idimsz      ! size of the dimensions of the variable 
     351     REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     352     INTEGER                        ::   itmp        ! temporary integer 
     353     CHARACTER(LEN=100)             ::   clinfo      ! info character 
    312354     !--------------------------------------------------------------------- 
    313      clinfo = 'iom_u_getv, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 
     355     ! 
     356     clinfo = '          iom_get_123d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 
    314357     ! local definition of the domain ? 
    315358     idom = kdom 
    316359     ! check kcount and kstart optionals parameters... 
    317      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) & 
     360     IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) )   & 
    318361          CALL ctl_stop( trim(clinfo), 'kcount present needs kstart present' ) 
    319      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) & 
     362     IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) )   & 
    320363          CALL ctl_stop( trim(clinfo), 'kstart present needs kcount present' ) 
    321      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) & 
     364     IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   )  & 
    322365          CALL ctl_stop( trim(clinfo), 'kstart present needs kdom = jpdom_unknown' ) 
    323366 
    324367     ! Search for the variable in the data base (eventually actualize data) 
    325      !- 
    326368     istop = nstop 
    327369     idvar = iom_varid( knumfl, cdvar ) 
    328370     ! 
    329      IF ( idvar > 0 ) THEN 
     371     IF( idvar > 0 ) THEN 
    330372        ! to write iom_file(knumfl)%dimsz in a shorter way ! 
    331373        idimsz(:) = iom_file(knumfl)%dimsz(:, idvar)  
    332         inbdim = iom_file(knumfl)%ndims(idvar)! number of dimensions in the file 
    333         idmspc = inbdim ! number of spatial dimensions in the file 
    334         IF( iom_file(knumfl)%luld(idvar) ) idmspc = inbdim - 1 
    335         IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions',   & 
    336              &                    'this case is not coded...')  
    337         ! Identify the domain in case of jpdom_local definition 
    338         !- 
    339         IF( idom == jpdom_local ) THEN 
     374        inbdim = iom_file(knumfl)%ndims(idvar)            ! number of dimensions in the file 
     375        idmspc = inbdim                                   ! number of spatial dimensions in the file 
     376        IF( iom_file(knumfl)%luld(idvar) )   idmspc = inbdim - 1 
     377        IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo),   & 
     378           &                    'the file has more than 3 spatial dimensions this case is not coded...' )  
     379        IF( idom == jpdom_local ) THEN        ! Identify the domain in case of jpdom_local definition 
    340380           IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN  
    341381              idom = jpdom_local_full 
     
    348388           ENDIF 
    349389        ENDIF 
    350  
     390        ! 
    351391        ! definition of istart and icnt 
    352         !- 
     392        ! 
    353393        ! initializations 
    354394        istart(:) = 1 
    355         icnt(:) = 1 
     395        icnt  (:) = 1 
    356396        itime = 1 
    357397        IF( PRESENT(ktime) ) itime = ktime 
     
    383423           CASE (2) 
    384424              ! data is 2d array (+ maybe a temporal dimension) 
    385               IF ( PRESENT(kstart) ) THEN 
     425              IF( PRESENT(kstart) ) THEN 
    386426                 istart(1:3) = (/ kstart(1:2), itime /) 
    387427                 icnt(1:2) = kcount(1:2) 
     
    404444              ENDIF 
    405445           CASE DEFAULT 
    406               IF ( itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
    407                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...', & 
    408                       &         'As the size of the z dimension is 1 and as we try to read the first reacord, ',     & 
    409                       &         'we accept this case even if there is a possible mix-up between z and time dimension...')            
    410                  IF ( PRESENT(kstart) ) THEN 
     446              IF( itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
     447                 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...',                & 
     448                      &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
     449                      &         'we accept this case even if there is a possible mix-up between z and time dimension' )            
     450                 IF( PRESENT(kstart) ) THEN 
    411451                    istart(1:2) = kstart(1:2) 
    412452                    icnt(1:2) = kcount(1:2) 
     
    428468                 ENDIF 
    429469              ELSE 
    430                  CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 2D array,', & 
    431                       &         'we do not accept data with more than 2 spatial dimension',     & 
    432                       &         'Use ncwa -a to suppress the unnecessary dimensions')            
     470                 CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 2D array,',           & 
     471                      &                       'we do not accept data with more than 2 spatial dimension',   & 
     472                      &                       'Use ncwa -a to suppress the unnecessary dimensions' ) 
    433473              ENDIF 
    434474           END SELECT 
    435475        ELSEIF( PRESENT(pv_r3d) ) THEN 
    436476           SELECT CASE (idmspc) 
    437            CASE (1) 
    438               CALL ctl_stop(trim(clinfo), 'the file has only 1 spatial dimension',   & 
    439                    &        'it is impossible to read a 3d array from this file...') 
    440            CASE (2) 
    441               CALL ctl_stop(trim(clinfo), 'the file has only 2 spatial dimension',   & 
    442                    &        'it is impossible to read a 3d array from this file...') 
    443            CASE (3) 
     477           CASE( 1 ) 
     478              CALL ctl_stop( trim(clinfo), 'the file has only 1 spatial dimension',            & 
     479                   &                       'it is impossible to read a 3d array from this file...' ) 
     480           CASE( 2 ) 
     481              CALL ctl_stop( trim(clinfo), 'the file has only 2 spatial dimension',            & 
     482                   &                       'it is impossible to read a 3d array from this file...' ) 
     483           CASE( 3 ) 
    444484              ! data is 3d array (+ maybe a temporal dimension) 
    445485              IF( PRESENT(kstart) ) THEN 
     
    469509              ENDIF 
    470510           CASE DEFAULT 
    471               CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 3D array,', & 
    472                    &         'we do not accept data with more than 3 spatial dimension',     & 
    473                    &         'Use ncwa -a to suppress the unnecessary dimensions')            
     511              CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 3D array,',   & 
     512                   &         'we do not accept data with more than 3 spatial dimension',         & 
     513                   &         'Use ncwa -a to suppress the unnecessary dimensions' )            
    474514           END SELECT 
    475515        ENDIF 
     
    491531           itmp = size(pv_r1d) 
    492532           WRITE(ctmp1,*) 'size(pv_r1d): ', itmp, ' /= icnt(1): ', icnt(1) 
    493            IF( itmp /= icnt(1) ) CALL ctl_stop( trim(clinfo), ctmp1 ) 
     533           IF( itmp /= icnt(1) )   CALL ctl_stop( trim(clinfo), ctmp1 ) 
    494534        ELSEIF( PRESENT(pv_r2d) ) THEN 
    495535           DO jl = 1, 2 
     
    501541                 WRITE(ctmp1,*) 'size(pv_r2d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl) 
    502542              ENDIF 
    503               IF( itmp /= icnt(jl) ) CALL ctl_stop( trim(clinfo), ctmp1 ) 
     543              IF( itmp /= icnt(jl) )   CALL ctl_stop( trim(clinfo), ctmp1 ) 
    504544           END DO 
    505545        ELSEIF( PRESENT(pv_r3d) ) THEN 
     
    512552                 WRITE(ctmp1,*) 'size(pv_r3d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl) 
    513553              ENDIF 
    514               IF( itmp /= icnt(jl) ) CALL ctl_stop( trim(clinfo), ctmp1 ) 
     554              IF( itmp /= icnt(jl) )   CALL ctl_stop( trim(clinfo), ctmp1 ) 
    515555           END DO 
    516556        ENDIF 
     
    520560     !-      
    521561     IF( istop == nstop) THEN ! no additional errors until this point... 
    522         ! 
    523         istop = nstop 
    524562        ! 
    525563        zscf = iom_file(knumfl)%scf(idvar)      ! scale factor 
     
    529567           CALL fliogetv( knumfl, cdvar, pv_r1d(:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 
    530568           !--- Apply scale_factor and offset 
    531            IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf  
    532            IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 
     569           IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf  
     570           IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs 
    533571        ELSEIF( PRESENT(pv_r2d) ) THEN 
    534572           IF( idom /= jpdom_unknown ) THEN 
    535573              CALL fliogetv( knumfl, cdvar, pv_r2d(nldi:nlei,nldj:nlej), start=istart(1:inbdim), count=icnt(1:inbdim) ) 
    536574              !--- Apply scale_factor and offset 
    537               IF (zscf /= 1.) pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) * zscf 
    538               IF (zofs /= 0.) pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) + zofs 
     575!CDIR NOUNROLL 
     576              IF( zscf /= 1.)   pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) * zscf 
     577!CDIR NOUNROLL 
     578              IF( zofs /= 0.)   pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) + zofs 
    539579              !--- Fill the overlap areas and extra hallows (mpp) 
    540580              CALL lbc_lnk (pv_r2d,'Z',-999.,'no0') 
     
    542582              CALL fliogetv( knumfl, cdvar, pv_r2d(:,:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 
    543583              !--- Apply scale_factor and offset 
    544               IF (zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 
    545               IF (zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 
     584!CDIR COLLAPSE 
     585              IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf 
     586!CDIR COLLAPSE 
     587              IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs 
    546588           ENDIF 
    547589        ELSEIF( PRESENT(pv_r3d) ) THEN 
    548590           IF( idom /= jpdom_unknown ) THEN 
    549               CALL fliogetv( knumfl, cdvar, pv_r3d(nldi:nlei,nldj:nlej,:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 
     591              CALL fliogetv( knumfl, cdvar, pv_r3d(nldi:nlei,nldj:nlej,:), start=istart(1:inbdim),   & 
     592                 &                                                         count=icnt  (1:inbdim) ) 
    550593              !--- Apply scale_factor and offset 
    551               IF( zscf /= 1. ) pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) * zscf 
    552               IF( zofs /= 0. ) pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) + zofs 
     594!CDIR NOUNROLL 
     595              IF( zscf /= 1. )   pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) * zscf 
     596!CDIR NOUNROLL 
     597              IF( zofs /= 0. )   pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) + zofs 
    553598              !--- Fill the overlap areas and extra hallows (mpp) 
    554599              IF( icnt(3) == jpk )   CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) ! this if could be removed with the new lbc_lnk ... 
     
    556601              CALL fliogetv( knumfl, cdvar, pv_r3d(:,:,:), start=istart(1:inbdim), count=icnt(1:inbdim) ) 
    557602              !--- Apply scale_factor and offset 
    558               IF (zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 
    559               IF (zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 
     603!CDIR COLLAPSE 
     604              IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 
     605!CDIR COLLAPSE 
     606              IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 
    560607           ENDIF 
    561608        ENDIF 
    562609        ! 
    563         IF( istop == nstop .AND. lwp )  & 
    564              &  WRITE(numout,*) ' read '//trim(cdvar)//' in '//trim(iom_file(knumfl)%name)//' ok' 
     610        IF( istop == nstop .AND. lwp )   & 
     611           WRITE(numout,*) '          read '//trim(cdvar)//' in '//trim(iom_file(knumfl)%name)//' ok' 
    565612     ENDIF 
    566613     ! 
    567    END SUBROUTINE iom_u_getv 
     614   END SUBROUTINE iom_get_123d 
    568615 
    569616    
    570617   SUBROUTINE iom_gettime( knumfl, cdvar, ptime ) 
    571      !!-------------------------------------------------------------------- 
    572      !!                   ***  SUBROUTINE  iom_close  *** 
    573      !! 
    574      !! ** Purpose : read the time axis cdvar in the file  
    575      !! 
    576      !! ** Method : 
    577      !! 
    578      !!-------------------------------------------------------------------- 
    579      INTEGER               , INTENT(in)  ::   knumfl   ! Identifier of the file to be closed 
    580      CHARACTER(len=*)      , INTENT(in)  ::   cdvar    ! time axis name 
    581      REAL(wp), DIMENSION(:), INTENT(out) ::   ptime    ! the time axis 
    582  
    583      INTEGER           :: idvar    ! id of the variable 
    584      CHARACTER(LEN=100) :: clinfo                    ! info character 
    585      !--------------------------------------------------------------------- 
    586      clinfo = 'iom_gettime, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar) 
    587      idvar = iom_varid( knumfl, cdvar ) 
    588      ! 
    589      ptime(:) = 0. ! default definition 
    590      IF ( idvar > 0 ) THEN 
    591         IF ( iom_file(knumfl)%ndims(idvar) == 1 ) THEN 
    592            IF ( iom_file(knumfl)%luld(idvar) ) THEN 
    593               IF ( iom_file(knumfl)%dimsz(1,idvar) == size(ptime) ) THEN 
    594                  CALL fliogetv( knumfl, cdvar, ptime(:), start=(/ 1 /), & 
    595                       &                                   count=(/ iom_file(knumfl)%dimsz(1,idvar) /) ) 
    596               ELSE