Changeset 8817


Ignore:
Timestamp:
2017-11-27T12:03:07+01:00 (3 years ago)
Author:
clem
Message:

make ice restart file shorter (this commit is on behalf of Madec)

Location:
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90

    r8637 r8817  
    1212   !!   'key_lim3'                                       ESIM sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!   ice_dyn_adv_pra   : advection of sea ice using Prather scheme 
     14   !!   ice_dyn_adv_pra : advection of sea ice using Prather scheme 
     15   !!   adv_x, adv_y    : Prather scheme applied in i- and j-direction, resp. 
     16   !!   adv_pra_init    : initialisation of the Prather scheme 
     17   !!   adv_pra_rst     : read/write Prather field in ice restart file, or initialized to zero 
    1518   !!---------------------------------------------------------------------- 
    1619   USE dom_oce        ! ocean domain 
     
    3235 
    3336   ! Moments for advection 
    34    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   ! open water in sea ice 
    3537   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   ! ice thickness  
    3638   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    ! snow thickness 
     
    3941   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   ! ice salinity 
    4042   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   ! ice age 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   ! open water in sea ice 
     44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     ! ice layers heat content 
    4145   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxap , syap , sxxap , syyap , sxyap    ! melt pond fraction 
    4246   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvp , syvp , sxxvp , syyvp , sxyvp    ! melt pond volume 
    43    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     ! ice layers heat content 
    44    ! 
     47 
    4548   !! * Substitutions 
    4649#  include "vectopt_loop_substitute.h90" 
     
    262265   END SUBROUTINE ice_dyn_adv_pra 
    263266    
     267    
    264268   SUBROUTINE adv_x( pdf, put , pcrh, psm , ps0 ,   & 
    265269      &              psx, psxx, psy , psyy, psxy ) 
     
    608612   END SUBROUTINE adv_y 
    609613 
     614 
    610615   SUBROUTINE adv_pra_init 
    611616      !!------------------------------------------------------------------- 
     
    616621      INTEGER ::   ierr 
    617622      !!------------------------------------------------------------------- 
     623      ! 
     624      !                             !* allocate prather fields 
    618625      ALLOCATE( sxopw(jpi,jpj)     , syopw(jpi,jpj)     , sxxopw(jpi,jpj)     , syyopw(jpi,jpj)     , sxyopw(jpi,jpj)     ,   & 
    619626         &      sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   & 
     
    632639      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'adv_pra_init : unable to allocate ice arrays for Prather advection scheme') 
    633640      ! 
    634       CALL adv_pra_rst( 'READ' )  !* read or initialize all required files 
     641      CALL adv_pra_rst( 'READ' )    !* read or initialize all required files 
    635642      ! 
    636643   END SUBROUTINE adv_pra_init 
     644 
    637645 
    638646   SUBROUTINE adv_pra_rst( cdrw, kt ) 
     
    652660      CHARACTER(len=25) ::   znam 
    653661      CHARACTER(len=2)  ::   zchar, zchar1 
    654       REAL(wp), DIMENSION(jpi,jpj) :: z2d 
     662      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace 
    655663      !!---------------------------------------------------------------------- 
    656664      ! 
    657       IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize 
    658          !                                   ! --------------- 
    659          IF( ln_rstart ) THEN                   !* Read the restart file 
    660             ! 
    661             id1 = iom_varid( numrir, 'sxopw' , ldstop = .FALSE. ) 
    662             ! 
    663             IF( id1 > 0 ) THEN      ! fields exist 
    664                DO jl = 1, jpl  
    665                   WRITE(zchar,'(I2.2)') jl 
    666                   znam = 'sxice'//'_htc'//zchar 
    667                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    668                   sxice(:,:,jl) = z2d(:,:) 
    669                   znam = 'syice'//'_htc'//zchar 
    670                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    671                   syice(:,:,jl) = z2d(:,:) 
    672                   znam = 'sxxice'//'_htc'//zchar 
    673                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    674                   sxxice(:,:,jl) = z2d(:,:) 
    675                   znam = 'syyice'//'_htc'//zchar 
    676                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    677                   syyice(:,:,jl) = z2d(:,:) 
    678                   znam = 'sxyice'//'_htc'//zchar 
    679                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    680                   sxyice(:,:,jl) = z2d(:,:) 
    681                   znam = 'sxsn'//'_htc'//zchar 
    682                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    683                   sxsn(:,:,jl) = z2d(:,:) 
    684                   znam = 'sysn'//'_htc'//zchar 
    685                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    686                   sysn(:,:,jl) = z2d(:,:) 
    687                   znam = 'sxxsn'//'_htc'//zchar 
    688                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    689                   sxxsn(:,:,jl) = z2d(:,:) 
    690                   znam = 'syysn'//'_htc'//zchar 
    691                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    692                   syysn(:,:,jl) = z2d(:,:) 
    693                   znam = 'sxysn'//'_htc'//zchar 
    694                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    695                   sxysn(:,:,jl) = z2d(:,:) 
    696                   znam = 'sxa'//'_htc'//zchar 
    697                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    698                   sxa(:,:,jl) = z2d(:,:) 
    699                   znam = 'sya'//'_htc'//zchar 
    700                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    701                   sya(:,:,jl) = z2d(:,:) 
    702                   znam = 'sxxa'//'_htc'//zchar 
    703                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    704                   sxxa(:,:,jl) = z2d(:,:) 
    705                   znam = 'syya'//'_htc'//zchar 
    706                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    707                   syya(:,:,jl) = z2d(:,:) 
    708                   znam = 'sxya'//'_htc'//zchar 
    709                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    710                   sxya(:,:,jl) = z2d(:,:) 
    711                   znam = 'sxc0'//'_htc'//zchar 
    712                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    713                   sxc0(:,:,jl) = z2d(:,:) 
    714                   znam = 'syc0'//'_htc'//zchar 
    715                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    716                   syc0(:,:,jl) = z2d(:,:) 
    717                   znam = 'sxxc0'//'_htc'//zchar 
    718                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    719                   sxxc0(:,:,jl) = z2d(:,:) 
    720                   znam = 'syyc0'//'_htc'//zchar 
    721                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    722                   syyc0(:,:,jl) = z2d(:,:) 
    723                   znam = 'sxyc0'//'_htc'//zchar 
    724                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    725                   sxyc0(:,:,jl) = z2d(:,:) 
    726                   znam = 'sxsal'//'_htc'//zchar 
    727                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    728                   sxsal(:,:,jl) = z2d(:,:) 
    729                   znam = 'sysal'//'_htc'//zchar 
    730                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    731                   sysal(:,:,jl) = z2d(:,:) 
    732                   znam = 'sxxsal'//'_htc'//zchar 
    733                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    734                   sxxsal(:,:,jl) = z2d(:,:) 
    735                   znam = 'syysal'//'_htc'//zchar 
    736                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    737                   syysal(:,:,jl) = z2d(:,:) 
    738                   znam = 'sxysal'//'_htc'//zchar 
    739                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    740                   sxysal(:,:,jl) = z2d(:,:) 
    741                   znam = 'sxage'//'_htc'//zchar 
    742                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    743                   sxage(:,:,jl) = z2d(:,:) 
    744                   znam = 'syage'//'_htc'//zchar 
    745                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    746                   syage(:,:,jl) = z2d(:,:) 
    747                   znam = 'sxxage'//'_htc'//zchar 
    748                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    749                   sxxage(:,:,jl) = z2d(:,:) 
    750                   znam = 'syyage'//'_htc'//zchar 
    751                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    752                   syyage(:,:,jl) = z2d(:,:) 
    753                   znam = 'sxyage'//'_htc'//zchar 
    754                   CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    755                   sxyage(:,:,jl)= z2d(:,:) 
    756                END DO 
    757                IF ( ln_pnd_H12 ) THEN 
    758                   DO jl = 1, jpl  
    759                      WRITE(zchar,'(I2.2)') jl 
    760                      znam = 'sxap'//'_htc'//zchar 
    761                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    762                      sxap(:,:,jl) = z2d(:,:) 
    763                      znam = 'syap'//'_htc'//zchar 
    764                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    765                      syap(:,:,jl) = z2d(:,:) 
    766                      znam = 'sxxap'//'_htc'//zchar 
    767                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    768                      sxxap(:,:,jl) = z2d(:,:) 
    769                      znam = 'syyap'//'_htc'//zchar 
    770                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    771                      syyap(:,:,jl) = z2d(:,:) 
    772                      znam = 'sxyap'//'_htc'//zchar 
    773                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    774                      sxyap(:,:,jl) = z2d(:,:) 
    775  
    776                      znam = 'sxvp'//'_htc'//zchar 
    777                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    778                      sxvp(:,:,jl) = z2d(:,:) 
    779                      znam = 'syvp'//'_htc'//zchar 
    780                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    781                      syvp(:,:,jl) = z2d(:,:) 
    782                      znam = 'sxxvp'//'_htc'//zchar 
    783                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    784                      sxxvp(:,:,jl) = z2d(:,:) 
    785                      znam = 'syyvp'//'_htc'//zchar 
    786                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    787                      syyvp(:,:,jl) = z2d(:,:) 
    788                      znam = 'sxyvp'//'_htc'//zchar 
    789                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    790                      sxyvp(:,:,jl) = z2d(:,:) 
    791                   END DO 
    792                ENDIF 
    793  
    794                CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  ) 
    795                CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  ) 
    796                CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw ) 
    797                CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw ) 
    798                CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw ) 
    799  
    800                DO jl = 1, jpl  
    801                   WRITE(zchar,'(I2.2)') jl 
    802                   DO jk = 1, nlay_i  
    803                      WRITE(zchar1,'(I2.2)') jk 
    804                      znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    805                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    806                      sxe(:,:,jk,jl) = z2d(:,:) 
    807                      znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    808                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    809                      sye(:,:,jk,jl) = z2d(:,:) 
    810                      znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    811                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    812                      sxxe(:,:,jk,jl) = z2d(:,:) 
    813                      znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    814                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    815                      syye(:,:,jk,jl) = z2d(:,:) 
    816                      znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    817                      CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    818                      sxye(:,:,jk,jl) = z2d(:,:) 
    819                   END DO 
    820                END DO 
    821                ! 
    822             ELSE                                     ! start rheology from rest 
    823                IF(lwp) WRITE(numout,*) '   ==>>   previous run without Prather, set moments to 0' 
    824                sxopw (:,:) = 0._wp   ;   sxice (:,:,:) = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:) = 0._wp 
    825                syopw (:,:) = 0._wp   ;   syice (:,:,:) = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:) = 0._wp 
    826                sxxopw(:,:) = 0._wp   ;   sxxice(:,:,:) = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:) = 0._wp 
    827                syyopw(:,:) = 0._wp   ;   syyice(:,:,:) = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:) = 0._wp 
    828                sxyopw(:,:) = 0._wp   ;   sxyice(:,:,:) = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:) = 0._wp 
    829                ! 
    830                sxc0  (:,:,:) = 0._wp   ;   sxe  (:,:,:,:) = 0._wp   ;   sxsal  (:,:,:) = 0._wp   ;   sxage  (:,:,:) = 0._wp 
    831                syc0  (:,:,:) = 0._wp   ;   sye  (:,:,:,:) = 0._wp   ;   sysal  (:,:,:) = 0._wp   ;   syage  (:,:,:) = 0._wp 
    832                sxxc0 (:,:,:) = 0._wp   ;   sxxe (:,:,:,:) = 0._wp   ;   sxxsal (:,:,:) = 0._wp   ;   sxxage (:,:,:) = 0._wp 
    833                syyc0 (:,:,:) = 0._wp   ;   syye (:,:,:,:) = 0._wp   ;   syysal (:,:,:) = 0._wp   ;   syyage (:,:,:) = 0._wp 
    834                sxyc0 (:,:,:) = 0._wp   ;   sxye (:,:,:,:) = 0._wp   ;   sxysal (:,:,:) = 0._wp   ;   sxyage (:,:,:) = 0._wp 
    835                IF ( ln_pnd_H12 ) THEN 
    836                   sxap  (:,:,:) = 0._wp    ; sxvp  (:,:,:) = 0._wp  
    837                   syap  (:,:,:) = 0._wp    ; syvp  (:,:,:) = 0._wp  
    838                   sxxap (:,:,:) = 0._wp    ; sxxvp (:,:,:) = 0._wp  
    839                   syyap (:,:,:) = 0._wp    ; syyvp (:,:,:) = 0._wp  
    840                   sxyap (:,:,:) = 0._wp    ; sxyvp (:,:,:) = 0._wp 
    841                ENDIF 
     665      !                                      !==========================! 
     666      IF( TRIM(cdrw) == 'READ' ) THEN        !==  Read or initialize  ==! 
     667         !                                   !==========================! 
     668         ! 
     669         IF( ln_rstart ) THEN   ;   id1 = iom_varid( numrir, 'sxopw' , ldstop = .FALSE. )    ! file exist: id1>0 
     670         ELSE                   ;   id1 = 0                                                  ! no restart: id1=0 
     671         ENDIF 
     672         ! 
     673         IF( id1 > 0 ) THEN                     !**  Read the restart file  **! 
     674            ! 
     675            !                                                        ! ice thickness 
     676            CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice  ) 
     677            CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice  ) 
     678            CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice ) 
     679            CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice ) 
     680            CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice ) 
     681            !                                                        ! snow thickness 
     682            CALL iom_get( numrir, jpdom_autoglo, 'sxsn'  , sxsn   ) 
     683            CALL iom_get( numrir, jpdom_autoglo, 'sysn'  , sysn   ) 
     684            CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn  ) 
     685            CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn  ) 
     686            CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn  ) 
     687            !                                                        ! lead fraction 
     688            CALL iom_get( numrir, jpdom_autoglo, 'sxa'   , sxa    ) 
     689            CALL iom_get( numrir, jpdom_autoglo, 'sya'   , sya    ) 
     690            CALL iom_get( numrir, jpdom_autoglo, 'sxxa'  , sxxa   ) 
     691            CALL iom_get( numrir, jpdom_autoglo, 'syya'  , syya   ) 
     692            CALL iom_get( numrir, jpdom_autoglo, 'sxya'  , sxya   ) 
     693            !                                                        ! snow thermal content 
     694            CALL iom_get( numrir, jpdom_autoglo, 'sxc0'  , sxc0   ) 
     695            CALL iom_get( numrir, jpdom_autoglo, 'syc0'  , syc0   ) 
     696            CALL iom_get( numrir, jpdom_autoglo, 'sxxc0' , sxxc0  ) 
     697            CALL iom_get( numrir, jpdom_autoglo, 'syyc0' , syyc0  ) 
     698            CALL iom_get( numrir, jpdom_autoglo, 'sxyc0' , sxyc0  ) 
     699            !                                                        ! ice salinity 
     700            CALL iom_get( numrir, jpdom_autoglo, 'sxsal' , sxsal  ) 
     701            CALL iom_get( numrir, jpdom_autoglo, 'sysal' , sysal  ) 
     702            CALL iom_get( numrir, jpdom_autoglo, 'sxxsal', sxxsal ) 
     703            CALL iom_get( numrir, jpdom_autoglo, 'syysal', syysal ) 
     704            CALL iom_get( numrir, jpdom_autoglo, 'sxysal', sxysal ) 
     705            !                                                        ! ice age 
     706            CALL iom_get( numrir, jpdom_autoglo, 'sxage' , sxage  ) 
     707            CALL iom_get( numrir, jpdom_autoglo, 'syage' , syage  ) 
     708            CALL iom_get( numrir, jpdom_autoglo, 'sxxage', sxxage ) 
     709            CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage ) 
     710            CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage ) 
     711            !                                                        ! open water in sea ice 
     712            CALL iom_get( numrir, jpdom_autoglo, 'sxopw ', sxopw  ) 
     713            CALL iom_get( numrir, jpdom_autoglo, 'syopw ', syopw  ) 
     714            CALL iom_get( numrir, jpdom_autoglo, 'sxxopw', sxxopw ) 
     715            CALL iom_get( numrir, jpdom_autoglo, 'syyopw', syyopw ) 
     716            CALL iom_get( numrir, jpdom_autoglo, 'sxyopw', sxyopw ) 
     717            !                                                        ! ice layers heat content 
     718            DO jk = 1, nlay_i  
     719               WRITE(zchar1,'(I2.2)') jk 
     720               znam = 'sxe'//'_il'//zchar1   ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxe (:,:,jk,:) = z3d(:,:,:) 
     721               znam = 'sye'//'_il'//zchar1   ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sye (:,:,jk,:) = z3d(:,:,:) 
     722               znam = 'sxxe'//'_il'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxxe(:,:,jk,:) = z3d(:,:,:) 
     723               znam = 'syye'//'_il'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   syye(:,:,jk,:) = z3d(:,:,:) 
     724               znam = 'sxye'//'_il'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxye(:,:,jk,:) = z3d(:,:,:) 
     725            END DO 
     726            ! 
     727            IF( ln_pnd_H12 ) THEN                                    ! melt pond fraction 
     728               CALL iom_get( numrir, jpdom_autoglo, 'sxap' , sxap  ) 
     729               CALL iom_get( numrir, jpdom_autoglo, 'syap' , syap  ) 
     730               CALL iom_get( numrir, jpdom_autoglo, 'sxxap', sxxap ) 
     731               CALL iom_get( numrir, jpdom_autoglo, 'syyap', syyap ) 
     732               CALL iom_get( numrir, jpdom_autoglo, 'sxyap', sxyap ) 
     733               !                                                     ! melt pond volume 
     734               CALL iom_get( numrir, jpdom_autoglo, 'sxvp' , sxvp  ) 
     735               CALL iom_get( numrir, jpdom_autoglo, 'syvp' , syvp  ) 
     736               CALL iom_get( numrir, jpdom_autoglo, 'sxxvp', sxxvp ) 
     737               CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp ) 
     738               CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp ) 
    842739            ENDIF 
    843          ELSE                                   !* Start from rest 
    844             IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set moments to 0' 
    845             sxopw (:,:) = 0._wp   ;   sxice (:,:,:) = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:) = 0._wp 
    846             syopw (:,:) = 0._wp   ;   syice (:,:,:) = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:) = 0._wp 
    847             sxxopw(:,:) = 0._wp   ;   sxxice(:,:,:) = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:) = 0._wp 
    848             syyopw(:,:) = 0._wp   ;   syyice(:,:,:) = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:) = 0._wp 
    849             sxyopw(:,:) = 0._wp   ;   sxyice(:,:,:) = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:) = 0._wp 
    850             ! 
    851             sxc0  (:,:,:) = 0._wp   ;   sxe  (:,:,:,:) = 0._wp   ;   sxsal  (:,:,:) = 0._wp   ;   sxage  (:,:,:) = 0._wp 
    852             syc0  (:,:,:) = 0._wp   ;   sye  (:,:,:,:) = 0._wp   ;   sysal  (:,:,:) = 0._wp   ;   syage  (:,:,:) = 0._wp 
    853             sxxc0 (:,:,:) = 0._wp   ;   sxxe (:,:,:,:) = 0._wp   ;   sxxsal (:,:,:) = 0._wp   ;   sxxage (:,:,:) = 0._wp 
    854             syyc0 (:,:,:) = 0._wp   ;   syye (:,:,:,:) = 0._wp   ;   syysal (:,:,:) = 0._wp   ;   syyage (:,:,:) = 0._wp 
    855             sxyc0 (:,:,:) = 0._wp   ;   sxye (:,:,:,:) = 0._wp   ;   sxysal (:,:,:) = 0._wp   ;   sxyage (:,:,:) = 0._wp 
    856             IF ( ln_pnd_H12 ) THEN 
    857                sxap  (:,:,:) = 0._wp    ; sxvp  (:,:,:) = 0._wp  
    858                syap  (:,:,:) = 0._wp    ; syvp  (:,:,:) = 0._wp  
    859                sxxap (:,:,:) = 0._wp    ; sxxvp (:,:,:) = 0._wp  
    860                syyap (:,:,:) = 0._wp    ; syyvp (:,:,:) = 0._wp  
    861                sxyap (:,:,:) = 0._wp    ; sxyvp (:,:,:) = 0._wp 
     740            ! 
     741         ELSE                                   !**  start rheology from rest  **! 
     742            ! 
     743            IF(lwp) WRITE(numout,*) '   ==>>   start from rest OR previous run without Prather, set moments to 0' 
     744            ! 
     745            sxice = 0._wp   ;   syice = 0._wp   ;   sxxice = 0._wp   ;   syyice = 0._wp   ;   sxyice = 0._wp      ! ice thickness 
     746            sxsn  = 0._wp   ;   sysn  = 0._wp   ;   sxxsn  = 0._wp   ;   syysn  = 0._wp   ;   sxysn  = 0._wp      ! snow thickness 
     747            sxa   = 0._wp   ;   sya   = 0._wp   ;   sxxa   = 0._wp   ;   syya   = 0._wp   ;   sxya   = 0._wp      ! lead fraction 
     748            sxc0  = 0._wp   ;   syc0  = 0._wp   ;   sxxc0  = 0._wp   ;   syyc0  = 0._wp   ;   sxyc0  = 0._wp      ! snow thermal content 
     749            sxsal = 0._wp   ;   sysal = 0._wp   ;   sxxsal = 0._wp   ;   syysal = 0._wp   ;   sxysal = 0._wp      ! ice salinity 
     750            sxage = 0._wp   ;   syage = 0._wp   ;   sxxage = 0._wp   ;   syyage = 0._wp   ;   sxyage = 0._wp      ! ice age 
     751            sxopw = 0._wp   ;   syopw = 0._wp   ;   sxxopw = 0._wp   ;   syyopw = 0._wp   ;   sxyopw = 0._wp      ! open water in sea ice 
     752            sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content 
     753            IF( ln_pnd_H12 ) THEN 
     754               sxap  = 0._wp   ;   syap  = 0._wp   ;   sxxap  = 0._wp   ;   syyap  = 0._wp   ;   sxyap  = 0._wp   ! melt pond fraction 
     755               sxvp  = 0._wp   ;   syvp  = 0._wp   ;   sxxvp  = 0._wp   ;   syyvp  = 0._wp   ;   sxyvp  = 0._wp   ! melt pond volume 
    862756            ENDIF 
    863757         ENDIF 
    864758         ! 
    865       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    866          !                                   ! ------------------- 
    867          IF(lwp) WRITE(numout,*) '---- adv-rst ----' 
     759         !                                   !=====================================! 
     760      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   !==  write in the ice restart file  ==! 
     761         !                                   !=====================================! 
     762         IF(lwp) WRITE(numout,*) '----  ice-adv-rst  ----' 
    868763         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1 
    869764         ! 
    870          DO jl = 1, jpl  
    871             WRITE(zchar,'(I2.2)') jl 
    872             znam = 'sxice'//'_htc'//zchar 
    873             z2d(:,:) = sxice(:,:,jl) 
    874             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    875             znam = 'syice'//'_htc'//zchar 
    876             z2d(:,:) = syice(:,:,jl) 
    877             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    878             znam = 'sxxice'//'_htc'//zchar 
    879             z2d(:,:) = sxxice(:,:,jl) 
    880             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    881             znam = 'syyice'//'_htc'//zchar 
    882             z2d(:,:) = syyice(:,:,jl) 
    883             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    884             znam = 'sxyice'//'_htc'//zchar 
    885             z2d(:,:) = sxyice(:,:,jl) 
    886             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    887             znam = 'sxsn'//'_htc'//zchar 
    888             z2d(:,:) = sxsn(:,:,jl) 
    889             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    890             znam = 'sysn'//'_htc'//zchar 
    891             z2d(:,:) = sysn(:,:,jl) 
    892             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    893             znam = 'sxxsn'//'_htc'//zchar 
    894             z2d(:,:) = sxxsn(:,:,jl) 
    895             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    896             znam = 'syysn'//'_htc'//zchar 
    897             z2d(:,:) = syysn(:,:,jl) 
    898             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    899             znam = 'sxysn'//'_htc'//zchar 
    900             z2d(:,:) = sxysn(:,:,jl) 
    901             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    902             znam = 'sxa'//'_htc'//zchar 
    903             z2d(:,:) = sxa(:,:,jl) 
    904             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    905             znam = 'sya'//'_htc'//zchar 
    906             z2d(:,:) = sya(:,:,jl) 
    907             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    908             znam = 'sxxa'//'_htc'//zchar 
    909             z2d(:,:) = sxxa(:,:,jl) 
    910             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    911             znam = 'syya'//'_htc'//zchar 
    912             z2d(:,:) = syya(:,:,jl) 
    913             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    914             znam = 'sxya'//'_htc'//zchar 
    915             z2d(:,:) = sxya(:,:,jl) 
    916             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    917             znam = 'sxc0'//'_htc'//zchar 
    918             z2d(:,:) = sxc0(:,:,jl) 
    919             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    920             znam = 'syc0'//'_htc'//zchar 
    921             z2d(:,:) = syc0(:,:,jl) 
    922             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    923             znam = 'sxxc0'//'_htc'//zchar 
    924             z2d(:,:) = sxxc0(:,:,jl) 
    925             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    926             znam = 'syyc0'//'_htc'//zchar 
    927             z2d(:,:) = syyc0(:,:,jl) 
    928             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    929             znam = 'sxyc0'//'_htc'//zchar 
    930             z2d(:,:) = sxyc0(:,:,jl) 
    931             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    932             znam = 'sxsal'//'_htc'//zchar 
    933             z2d(:,:) = sxsal(:,:,jl) 
    934             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    935             znam = 'sysal'//'_htc'//zchar 
    936             z2d(:,:) = sysal(:,:,jl) 
    937             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    938             znam = 'sxxsal'//'_htc'//zchar 
    939             z2d(:,:) = sxxsal(:,:,jl) 
    940             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    941             znam = 'syysal'//'_htc'//zchar 
    942             z2d(:,:) = syysal(:,:,jl) 
    943             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    944             znam = 'sxysal'//'_htc'//zchar 
    945             z2d(:,:) = sxysal(:,:,jl) 
    946             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    947             znam = 'sxage'//'_htc'//zchar 
    948             z2d(:,:) = sxage(:,:,jl) 
    949             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    950             znam = 'syage'//'_htc'//zchar 
    951             z2d(:,:) = syage(:,:,jl) 
    952             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    953             znam = 'sxxage'//'_htc'//zchar 
    954             z2d(:,:) = sxxage(:,:,jl) 
    955             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    956             znam = 'syyage'//'_htc'//zchar 
    957             z2d(:,:) = syyage(:,:,jl) 
    958             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    959             znam = 'sxyage'//'_htc'//zchar 
    960             z2d(:,:) = sxyage(:,:,jl) 
    961             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    962          END DO 
    963  
    964          CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  ) 
    965          CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  ) 
    966          CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw ) 
    967          CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw ) 
    968          CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw ) 
    969           
    970          DO jl = 1, jpl  
    971             WRITE(zchar,'(I2.2)') jl 
    972             DO jk = 1, nlay_i  
    973                WRITE(zchar1,'(I2.2)') jk 
    974                znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    975                z2d(:,:) = sxe(:,:,jk,jl) 
    976                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    977                znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    978                z2d(:,:) = sye(:,:,jk,jl) 
    979                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    980                znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    981                z2d(:,:) = sxxe(:,:,jk,jl) 
    982                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    983                znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    984                z2d(:,:) = syye(:,:,jk,jl) 
    985                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    986                znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    987                z2d(:,:) = sxye(:,:,jk,jl) 
    988                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    989             END DO 
    990          END DO 
    991          IF ( ln_pnd_H12 ) THEN 
    992             DO jl = 1, jpl  
    993                WRITE(zchar,'(I2.2)') jl 
    994                znam = 'sxap'//'_htc'//zchar 
    995                z2d(:,:) = sxap(:,:,jl) 
    996                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    997                znam = 'syap'//'_htc'//zchar 
    998                z2d(:,:) = syap(:,:,jl) 
    999                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1000                znam = 'sxxap'//'_htc'//zchar 
    1001                z2d(:,:) = sxxap(:,:,jl) 
    1002                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1003                znam = 'syyap'//'_htc'//zchar 
    1004                z2d(:,:) = syyap(:,:,jl) 
    1005                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1006                znam = 'sxyap'//'_htc'//zchar 
    1007                z2d(:,:) = sxyap(:,:,jl) 
    1008                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1009     
    1010                znam = 'sxvp'//'_htc'//zchar 
    1011                z2d(:,:) = sxvp(:,:,jl) 
    1012                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1013                znam = 'syvp'//'_htc'//zchar 
    1014                z2d(:,:) = syvp(:,:,jl) 
    1015                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1016                znam = 'sxxvp'//'_htc'//zchar 
    1017                z2d(:,:) = sxxvp(:,:,jl) 
    1018                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1019                znam = 'syyvp'//'_htc'//zchar 
    1020                z2d(:,:) = syyvp(:,:,jl) 
    1021                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1022                znam = 'sxyvp'//'_htc'//zchar 
    1023                z2d(:,:) = sxyvp(:,:,jl) 
    1024                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    1025             END DO 
     765         ! 
     766         ! In case Prather scheme is used for advection, write second order moments 
     767         ! ------------------------------------------------------------------------ 
     768         ! 
     769         !                                                           ! ice thickness 
     770         CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice  ) 
     771         CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice  ) 
     772         CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice ) 
     773         CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice ) 
     774         CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice ) 
     775         !                                                           ! snow thickness 
     776         CALL iom_rstput( iter, nitrst, numriw, 'sxsn'  , sxsn   ) 
     777         CALL iom_rstput( iter, nitrst, numriw, 'sysn'  , sysn   ) 
     778         CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn  ) 
     779         CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn  ) 
     780         CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn  ) 
     781         !                                                           ! lead fraction 
     782         CALL iom_rstput( iter, nitrst, numriw, 'sxa'   , sxa    ) 
     783         CALL iom_rstput( iter, nitrst, numriw, 'sya'   , sya    ) 
     784         CALL iom_rstput( iter, nitrst, numriw, 'sxxa'  , sxxa   ) 
     785         CALL iom_rstput( iter, nitrst, numriw, 'syya'  , syya   ) 
     786         CALL iom_rstput( iter, nitrst, numriw, 'sxya'  , sxya   ) 
     787         !                                                           ! snow thermal content 
     788         CALL iom_rstput( iter, nitrst, numriw, 'sxc0'  , sxc0   ) 
     789         CALL iom_rstput( iter, nitrst, numriw, 'syc0'  , syc0   ) 
     790         CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0  ) 
     791         CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0  ) 
     792         CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0  ) 
     793         !                                                           ! ice salinity 
     794         CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal  ) 
     795         CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal  ) 
     796         CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal ) 
     797         CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal ) 
     798         CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal ) 
     799         !                                                           ! ice age 
     800         CALL iom_rstput( iter, nitrst, numriw, 'sxage' , sxage  ) 
     801         CALL iom_rstput( iter, nitrst, numriw, 'syage' , syage  ) 
     802         CALL iom_rstput( iter, nitrst, numriw, 'sxxage', sxxage ) 
     803         CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage ) 
     804         CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage ) 
     805         !                                                           ! open water in sea ice 
     806         CALL iom_rstput( iter, nitrst, numriw, 'sxopw ', sxopw  ) 
     807         CALL iom_rstput( iter, nitrst, numriw, 'syopw ', syopw  ) 
     808         CALL iom_rstput( iter, nitrst, numriw, 'sxxopw', sxxopw ) 
     809         CALL iom_rstput( iter, nitrst, numriw, 'syyopw', syyopw ) 
     810         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw', sxyopw ) 
     811         !                                                           ! ice layers heat content 
     812         DO jk = 1, nlay_i  
     813            WRITE(zchar1,'(I2.2)') jk 
     814            znam = 'sxe'//'_il'//zchar1   ;   z3d(:,:,:) = sxe (:,:,jk,:)   ;   CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     815            znam = 'sye'//'_il'//zchar1   ;   z3d(:,:,:) = sye (:,:,jk,:)   ;   CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     816            znam = 'sxxe'//'_il'//zchar1  ;   z3d(:,:,:) = sxxe(:,:,jk,:)   ;   CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     817            znam = 'syye'//'_il'//zchar1  ;   z3d(:,:,:) = syye(:,:,jk,:)   ;   CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     818            znam = 'sxye'//'_il'//zchar1  ;   z3d(:,:,:) = sxye(:,:,jk,:)   ;   CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     819         END DO 
     820         ! 
     821         IF( ln_pnd_H12 ) THEN                                       ! melt pond fraction 
     822            CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap  ) 
     823            CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap  ) 
     824            CALL iom_rstput( iter, nitrst, numriw, 'sxxap', sxxap ) 
     825            CALL iom_rstput( iter, nitrst, numriw, 'syyap', syyap ) 
     826            CALL iom_rstput( iter, nitrst, numriw, 'sxyap', sxyap ) 
     827            !                                                        ! melt pond volume 
     828            CALL iom_rstput( iter, nitrst, numriw, 'sxvp' , sxvp  ) 
     829            CALL iom_rstput( iter, nitrst, numriw, 'syvp' , syvp  ) 
     830            CALL iom_rstput( iter, nitrst, numriw, 'sxxvp', sxxvp ) 
     831            CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) 
     832            CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) 
    1026833         ENDIF 
    1027834         ! 
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90

    r8637 r8817  
    66   !! History:   3.0  ! 2005-04 (M. Vancoppenolle) Original code 
    77   !!             -   ! 2008-03 (C. Ethe) restart files in using IOM interface 
    8    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     8   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
     9   !!            4.0  ! 2017-11 (M. Andrejczuk) Extend IOM interface to write 3D ice fields 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_lim3 
     
    8283            ENDIF 
    8384            ! 
    84             CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     85            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 
    8586            lrst_ice = .TRUE. 
    8687         ENDIF 
     
    8889      ! 
    8990      IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print 
     91      ! 
    9092   END SUBROUTINE ice_rst_opn 
    9193 
     
    103105      CHARACTER(len=25) ::   znam 
    104106      CHARACTER(len=2)  ::   zchar, zchar1 
    105       REAL(wp), DIMENSION(jpi,jpj) :: z2d 
     107      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace 
    106108      !!---------------------------------------------------------------------- 
    107109 
     
    120122      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date 
    121123 
    122 !!gm   It is possible and easy to define a 3D domain size (jpi,jpj,jpl) or use a SIZE( tab, DIM=3) in iom_rtput ) 
    123 !!gm         ===>>> just a simple   iom_rstput( iter, nitrst, numriw, 'v_i', v_i )  etc... 
    124 !!gm   "just" ask Sebatien 
    125  
    126       ! Prognostic variables  
    127       DO jl = 1, jpl  
    128          WRITE(zchar,'(I2.2)') jl 
    129          znam = 'v_i'//'_htc'//zchar 
    130          z2d(:,:) = v_i(:,:,jl) 
    131          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_i 
    132          znam = 'v_s'//'_htc'//zchar 
    133          z2d(:,:) = v_s(:,:,jl) 
    134          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_s 
    135          znam = 'sv_i'//'_htc'//zchar 
    136          z2d(:,:) = sv_i(:,:,jl) 
    137          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! sv_i 
    138          znam = 'oa_i'//'_htc'//zchar 
    139          z2d(:,:) = oa_i(:,:,jl) 
    140          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! oa_i 
    141          znam = 'a_i'//'_htc'//zchar 
    142          z2d(:,:) = a_i(:,:,jl) 
    143          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! a_i 
    144          znam = 't_su'//'_htc'//zchar 
    145          z2d(:,:) = t_su(:,:,jl) 
    146          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! t_su 
     124      ! Prognostic variables 
     125      CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i  ) 
     126      CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s  ) 
     127      CALL iom_rstput( iter, nitrst, numriw, 'sv_i', sv_i ) 
     128      CALL iom_rstput( iter, nitrst, numriw, 'oa_i', oa_i ) 
     129      CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i  ) 
     130      CALL iom_rstput( iter, nitrst, numriw, 't_su', t_su ) 
     131      ! 
     132      ! Melt ponds 
     133      CALL iom_rstput( iter, nitrst, numriw, 'a_ip', a_ip ) 
     134      CALL iom_rstput( iter, nitrst, numriw, 'v_ip', v_ip ) 
     135      ! 
     136!!gm dangerous !!!!!  ===>>>> better reading writing all snow layers ! 
     137      ! Snow enthalpy (1st snow layer only) 
     138      z3d = e_s(:,:,1,:) 
     139      CALL iom_rstput( iter, nitrst, numriw, 'tempt_sl1' , z3d ) 
     140      ! 
     141      ! Ice enthalpy (all ice layers) 
     142      DO jk = 1, nlay_i  
     143         WRITE(zchar1,'(I2.2)') jk 
     144         znam = 'tempt'//'_il'//zchar1 
     145         z3d(:,:,:) = e_i(:,:,jk,:) 
     146         CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
    147147      END DO 
    148  
    149       DO jl = 1, jpl  
    150          WRITE(zchar,'(I2.2)') jl 
    151          znam = 'a_ip'//'_htc'//zchar 
    152          z2d(:,:) = a_ip(:,:,jl) 
    153          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! a_ip 
    154          znam = 'v_ip'//'_htc'//zchar 
    155          z2d(:,:) = v_ip(:,:,jl) 
    156          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_ip 
    157       END DO 
    158  
    159       DO jl = 1, jpl  
    160          WRITE(zchar,'(I2.2)') jl 
    161          znam = 'tempt_sl1'//'_htc'//zchar 
    162          z2d(:,:) = e_s(:,:,1,jl) 
    163          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! e_s 
    164          DO jk = 1, nlay_i  
    165             WRITE(zchar1,'(I2.2)') jk 
    166             znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    167             z2d(:,:) = e_i(:,:,jk,jl) 
    168             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! e_i 
    169          END DO 
    170       END DO 
    171  
     148      ! 
     149      ! ice velocity 
    172150      CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) ! u_ice 
    173151      CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) ! v_ice 
     
    189167      !! ** purpose  :   read restart file 
    190168      !!---------------------------------------------------------------------- 
    191       INTEGER  ::   jk, jl 
    192       INTEGER  ::   id1            ! local integer 
    193       REAL(wp) ::   zfice, ziter 
    194       REAL(wp), DIMENSION(jpi,jpj) ::   z2d 
     169      INTEGER           ::   jk, jl 
     170      LOGICAL           ::   llok 
     171      INTEGER           ::   id1            ! local integer 
     172      INTEGER           ::   jlibalt = jprstlib 
    195173      CHARACTER(len=25) ::   znam 
    196174      CHARACTER(len=2)  ::   zchar, zchar1 
    197       INTEGER           ::   jlibalt = jprstlib 
    198       LOGICAL           ::   llok 
     175      REAL(wp)          ::   zfice, ziter 
     176      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace 
    199177      !!---------------------------------------------------------------------- 
    200178 
     
    205183      ENDIF 
    206184 
    207       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 
     185      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib, kdlev = jpl ) 
    208186 
    209187      CALL iom_get( numrir, 'nn_fsbc', zfice ) 
     
    223201 
    224202      ! Prognostic variables  
    225       DO jl = 1, jpl  
    226          WRITE(zchar,'(I2.2)') jl 
    227          znam = 'v_i'//'_htc'//zchar 
    228          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    229          v_i(:,:,jl) = z2d(:,:) 
    230          znam = 'v_s'//'_htc'//zchar 
    231          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    232          v_s(:,:,jl) = z2d(:,:)  
    233          znam = 'sv_i'//'_htc'//zchar 
    234          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    235          sv_i(:,:,jl) = z2d(:,:) 
    236          znam = 'oa_i'//'_htc'//zchar 
    237          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    238          oa_i(:,:,jl) = z2d(:,:) 
    239          znam = 'a_i'//'_htc'//zchar 
    240          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    241          a_i(:,:,jl) = z2d(:,:) 
    242          znam = 't_su'//'_htc'//zchar 
    243          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    244          t_su(:,:,jl) = z2d(:,:) 
    245       END DO 
    246  
     203      CALL iom_get( numrir, jpdom_autoglo, 'v_i' , v_i  ) 
     204      CALL iom_get( numrir, jpdom_autoglo, 'v_s' , v_s  ) 
     205      CALL iom_get( numrir, jpdom_autoglo, 'sv_i', sv_i ) 
     206      CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 
     207      CALL iom_get( numrir, jpdom_autoglo, 'a_i' , a_i  ) 
     208      CALL iom_get( numrir, jpdom_autoglo, 't_su', t_su ) 
     209      ! 
     210      ! Melt ponds 
    247211      id1 = iom_varid( numrir, 'a_ip_htc01' , ldstop = .FALSE. ) 
    248212      IF( id1 > 0 ) THEN                       ! fields exist (melt ponds) 
    249          DO jl = 1, jpl  
    250             WRITE(zchar,'(I2.2)') jl 
    251             znam = 'a_ip'//'_htc'//zchar 
    252             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    253             a_ip(:,:,jl) = z2d(:,:) 
    254             znam = 'v_ip'//'_htc'//zchar 
    255             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    256             v_ip(:,:,jl) = z2d(:,:) 
    257          END DO 
     213         CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 
     214         CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 
    258215      ELSE                                     ! start from rest 
    259          IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it' 
     216         IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero' 
    260217         a_ip(:,:,:) = 0._wp 
    261218         v_ip(:,:,:) = 0._wp 
    262219      ENDIF 
    263  
    264       DO jl = 1, jpl  
    265          WRITE(zchar,'(I2.2)') jl 
    266          znam = 'tempt_sl1'//'_htc'//zchar 
    267          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    268          e_s(:,:,1,jl) = z2d(:,:) 
    269          DO jk = 1, nlay_i  
    270             WRITE(zchar1,'(I2.2)') jk 
    271             znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    272             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    273             e_i(:,:,jk,jl) = z2d(:,:) 
    274          END DO 
     220      ! 
     221!!gm dangerous !!!!!  ===>>>> better reading writing all snow layers ! 
     222      ! Snow enthalpy (1st snow layer only) 
     223      CALL iom_get( numrir, jpdom_autoglo, 'tempt_sl1' , z3d ) 
     224      e_s(:,:,1,:) = z3d 
     225      ! 
     226      ! Ice enthalpy (all ice layers) 
     227      DO jk = 1, nlay_i  
     228         WRITE(zchar1,'(I2.2)') jk 
     229         znam = 'tempt'//'_il'//zchar1 
     230         CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     231         e_i(:,:,jk,:) = z3d(:,:,:) 
    275232      END DO 
    276  
     233      ! 
     234      ! ice velocity 
    277235      CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 
    278236      CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r8586 r8817  
    11MODULE iom 
    2    !!===================================================================== 
     2   !!====================================================================== 
    33   !!                    ***  MODULE  iom *** 
    44   !! Input/Output manager :  Library to read input files 
    5    !!==================================================================== 
     5   !!====================================================================== 
    66   !! History :  2.0  ! 2005-12  (J. Belier) Original code 
    77   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO 
     
    1010   !!            3.6  ! 2014-15  DIMG format removed 
    1111   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes 
    12    !!-------------------------------------------------------------------- 
    13  
    14    !!-------------------------------------------------------------------- 
     12   !!            4.0  ! 2017-11  (M. Andrejczuk) Extend IOM interface to write any 3D fields 
     13   !!---------------------------------------------------------------------- 
     14 
     15   !!---------------------------------------------------------------------- 
    1516   !!   iom_open       : open a file read only 
    1617   !!   iom_close      : close a file or all files opened by iom 
     
    1920   !!   iom_varid      : get the id of a variable in a file 
    2021   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    21    !!-------------------------------------------------------------------- 
     22   !!---------------------------------------------------------------------- 
    2223   USE dom_oce         ! ocean space and time domain 
    2324   USE c1d             ! 1D vertical configuration 
     
    2930   USE lib_mpp           ! MPP library 
    3031#if defined key_iomput 
    31    USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain 
    32    USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
    33    USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes 
     32   USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain 
     33   USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
     34   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes 
    3435#if defined key_lim3 
    35    USE ice    , ONLY :   jpl 
     36   USE ice      , ONLY :   jpl 
    3637#endif 
    3738   USE domngb          ! ocean space and time domain 
     
    8081 
    8182   !!---------------------------------------------------------------------- 
    82    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     83   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    8384   !! $Id$ 
    8485   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    8586   !!---------------------------------------------------------------------- 
    86  
    8787CONTAINS 
    8888 
     
    9595      !!---------------------------------------------------------------------- 
    9696      CHARACTER(len=*), INTENT(in)  :: cdname 
     97      ! 
    9798#if defined key_iomput 
    98  
     99      ! 
    99100      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0) 
    100101      TYPE(xios_date)     :: start_date 
     
    104105      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
    105106      !!---------------------------------------------------------------------- 
    106  
     107      ! 
    107108      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 
    108  
     109      ! 
    109110      clname = cdname 
    110111      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 
     
    125126      ! horizontal grid definition 
    126127      CALL set_scalar 
    127  
     128      ! 
    128129      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    129130         CALL set_grid( "T", glamt, gphit )  
     
    144145         ENDIF 
    145146      ENDIF 
    146  
     147      ! 
    147148      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN   
    148149         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     
    167168         ENDIF 
    168169      ENDIF 
    169  
     170      ! 
    170171      ! vertical grid definition 
    171172      CALL iom_set_axis_attr( "deptht", gdept_1d ) 
     
    173174      CALL iom_set_axis_attr( "depthv", gdept_1d ) 
    174175      CALL iom_set_axis_attr( "depthw", gdepw_1d ) 
    175  
     176      ! 
    176177      ! Add vertical grid bounds 
    177178      jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
     
    186187      CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 
    187188      CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 
    188  
    189  
     189      ! 
    190190# if defined key_floats 
    191191      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
    192192# endif 
    193 #if defined key_lim3 
     193# if defined key_lim3 
    194194      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
    195195      ! SIMIP diagnostics (4 main arctic straits) 
    196196      CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 
    197 #endif 
     197# endif 
    198198      CALL iom_set_axis_attr( "icbcla", class_num ) 
    199199      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 
     
    202202      ! automatic definitions of some of the xml attributs 
    203203      CALL set_xmlatt 
    204  
     204      ! 
    205205      ! end file definition 
    206206      dtime%second = rdt 
     
    209209       
    210210      CALL xios_update_calendar(0) 
    211  
     211      ! 
    212212      DEALLOCATE( zt_bnds, zw_bnds ) 
    213  
     213      ! 
    214214#endif 
    215        
     215      ! 
    216216   END SUBROUTINE iom_init 
    217217 
     
    239239 
    240240 
    241    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof ) 
     241   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof, kdlev ) 
    242242      !!--------------------------------------------------------------------- 
    243243      !!                   ***  SUBROUTINE  iom_open  *** 
     
    252252      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    253253      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
     254      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels 
    254255 
    255256      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
     
    405406      IF( istop == nstop ) THEN   ! no error within this routine 
    406407         SELECT CASE (iolib) 
    407          CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar ) 
     408         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 
    408409         CASE DEFAULT 
    409410            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 
     
    672673      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    673674      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
     675      INTEGER                        ::   inlev       ! number of levels for 3D data 
    674676      !--------------------------------------------------------------------- 
    675677      ! 
     678      inlev = -1 
     679      IF( PRESENT(pv_r3d) )   inlev = SIZE(pv_r3d, 3) 
    676680      clname = iom_file(kiomid)%name   !   esier to read 
    677681      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 
     
    774778         istart(idmspc+1) = itime 
    775779 
    776          IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 
     780         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN  
     781            istart(1:idmspc) = kstart(1:idmspc)  
     782            icnt(1:idmspc) = kcount(1:idmspc) 
    777783         ELSE 
    778             IF(           idom == jpdom_unknown ) THEN                                                ; icnt(1:idmspc) = idimsz(1:idmspc) 
     784            IF(idom == jpdom_unknown ) THEN 
     785               icnt(1:idmspc) = idimsz(1:idmspc) 
    779786            ELSE  
    780787               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
     
    799806                  ENDIF 
    800807                  IF( PRESENT(pv_r3d) ) THEN 
    801                      IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkglo 
     808                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = inlev 
    802809                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
    803                      ELSE                                                           ; icnt(3) = jpk 
     810                     ELSE                                                           ; icnt(3) = inlev 
    804811                     ENDIF 
    805812                  ENDIF 
     
    884891            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    885892               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    886                IF( icnt(3) == jpk ) THEN 
     893               IF( icnt(3) == inlev ) THEN 
    887894                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
    888895               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
     
    11331140   END SUBROUTINE iom_rp0d 
    11341141 
     1142 
    11351143   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
    11361144      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     
    11531161   END SUBROUTINE iom_rp1d 
    11541162 
     1163 
    11551164   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
    11561165      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     
    11731182   END SUBROUTINE iom_rp2d 
    11741183 
     1184 
    11751185   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
    11761186      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     
    12341244      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    12351245#if defined key_iomput 
    1236       CALL xios_send_field(cdname, pfield3d) 
     1246      CALL xios_send_field( cdname, pfield3d ) 
    12371247#else 
    12381248      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    12391249#endif 
    12401250   END SUBROUTINE iom_p3d 
     1251 
     1252#if defined key_iomput 
     1253 
    12411254   !!---------------------------------------------------------------------- 
    1242  
    1243 #if defined key_iomput 
     1255   !!   'key_iomput'                                         IOM  interface 
     1256   !!---------------------------------------------------------------------- 
    12441257 
    12451258   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
    12461259      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     & 
    12471260      &                                    nvertex, bounds_lon, bounds_lat, area ) 
    1248       CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    1249       INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
    1250       INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    1251       INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 
    1252       REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1253       REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    1254       LOGICAL, DIMENSION(:)   , OPTIONAL, INTENT(in) ::   mask 
    1255  
    1256  
    1257       IF ( xios_is_valid_domain     (cdid) ) THEN 
     1261      !!---------------------------------------------------------------------- 
     1262      !!---------------------------------------------------------------------- 
     1263      CHARACTER(LEN=*)                  , INTENT(in) ::   cdid 
     1264      INTEGER                 , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     1265      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
     1266      INTEGER                 , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 
     1267      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     1268      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
     1269      LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask 
     1270      !!---------------------------------------------------------------------- 
     1271      ! 
     1272      IF( xios_is_valid_domain     (cdid) ) THEN 
    12581273         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    12591274            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     
    12611276            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
    12621277     ENDIF 
    1263       IF ( xios_is_valid_domaingroup(cdid) ) THEN 
     1278      IF( xios_is_valid_domaingroup(cdid) ) THEN 
    12641279         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    12651280            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     
    12671282            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
    12681283      ENDIF 
    1269  
     1284      ! 
    12701285      CALL xios_solve_inheritance() 
    1271  
     1286      ! 
    12721287   END SUBROUTINE iom_set_domain_attr 
    12731288 
    12741289 
    1275    SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 
    1276       CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    1277       INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj 
    1278  
    1279       IF ( xios_is_valid_zoom_domain     (cdid) ) THEN 
    1280           CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    & 
    1281             &   nj=nj) 
    1282      ENDIF 
     1290   SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj ) 
     1291      !!---------------------------------------------------------------------- 
     1292      !!---------------------------------------------------------------------- 
     1293      CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
     1294      INTEGER         , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj 
     1295      !!---------------------------------------------------------------------- 
     1296      IF( xios_is_valid_zoom_domain(cdid) )   CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj ) 
    12831297   END SUBROUTINE iom_set_zoom_domain_attr 
    12841298 
    12851299 
    12861300   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 
     1301      !!---------------------------------------------------------------------- 
     1302      !!---------------------------------------------------------------------- 
    12871303      CHARACTER(LEN=*)      , INTENT(in) ::   cdid 
    12881304      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis 
    12891305      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
    1290  
    1291       IF ( PRESENT(paxis) ) THEN 
    1292          IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1293          IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1294       ENDIF 
    1295       IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    1296       IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
     1306      !!---------------------------------------------------------------------- 
     1307      IF( PRESENT(paxis) ) THEN 
     1308         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1309         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1310      ENDIF 
     1311      IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
     1312      IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
    12971313      CALL xios_solve_inheritance() 
    12981314   END SUBROUTINE iom_set_axis_attr 
     
    13001316 
    13011317   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 
    1302       CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    1303       TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op 
    1304       TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset 
    1305       IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       & 
    1306     &     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    1307       IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  & 
    1308     &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
     1318      !!---------------------------------------------------------------------- 
     1319      !!---------------------------------------------------------------------- 
     1320      CHARACTER(LEN=*)             , INTENT(in) ::   cdid 
     1321      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_op 
     1322      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_offset 
     1323      !!---------------------------------------------------------------------- 
     1324      IF( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
     1325      IF( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    13091326      CALL xios_solve_inheritance() 
    13101327   END SUBROUTINE iom_set_field_attr 
     
    13121329 
    13131330   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 
     1331      !!---------------------------------------------------------------------- 
     1332      !!---------------------------------------------------------------------- 
    13141333      CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    13151334      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix 
    1316       IF ( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix ) 
    1317       IF ( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 
     1335      !!---------------------------------------------------------------------- 
     1336      IF( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix ) 
     1337      IF( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 
    13181338      CALL xios_solve_inheritance() 
    13191339   END SUBROUTINE iom_set_file_attr 
     
    13211341 
    13221342   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 
     1343      !!---------------------------------------------------------------------- 
     1344      !!---------------------------------------------------------------------- 
    13231345      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid 
    13241346      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix 
     
    13291351      IF( PRESENT( name_suffix ) )   name_suffix = '' 
    13301352      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0) 
    1331       IF ( xios_is_valid_file     (cdid) ) THEN 
     1353      IF( xios_is_valid_file     (cdid) ) THEN 
    13321354         CALL xios_solve_inheritance() 
    13331355         CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 
     
    13361358         IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq ) 
    13371359      ENDIF 
    1338       IF ( xios_is_valid_filegroup(cdid) ) THEN 
     1360      IF( xios_is_valid_filegroup(cdid) ) THEN 
    13391361         CALL xios_solve_inheritance() 
    13401362         CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 
     
    13471369 
    13481370   SUBROUTINE iom_set_grid_attr( cdid, mask ) 
     1371      !!---------------------------------------------------------------------- 
     1372      !!---------------------------------------------------------------------- 
    13491373      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    13501374      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask 
    1351       IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask ) 
    1352       IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 
     1375      !!---------------------------------------------------------------------- 
     1376      IF( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask ) 
     1377      IF( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 
    13531378      CALL xios_solve_inheritance() 
    13541379   END SUBROUTINE iom_set_grid_attr 
    13551380 
    13561381   SUBROUTINE iom_setkt( kt, cdname ) 
     1382      !!---------------------------------------------------------------------- 
     1383      !!---------------------------------------------------------------------- 
    13571384      INTEGER         , INTENT(in) ::   kt  
    13581385      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    1359       !      
     1386      !!---------------------------------------------------------------------- 
    13601387      CALL iom_swap( cdname )   ! swap to cdname context 
    13611388      CALL xios_update_calendar(kt) 
    1362       IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    1363       ! 
     1389      IF( cdname /= TRIM(cxios_context) )   CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    13641390   END SUBROUTINE iom_setkt 
    13651391 
    13661392   SUBROUTINE iom_context_finalize( cdname ) 
     1393      !!---------------------------------------------------------------------- 
     1394      !!---------------------------------------------------------------------- 
    13671395      CHARACTER(LEN=*), INTENT(in) :: cdname 
    1368       ! 
     1396      !!---------------------------------------------------------------------- 
    13691397      IF( xios_is_valid_context(cdname) ) THEN 
    13701398         CALL iom_swap( cdname )   ! swap to cdname context 
     
    13721400         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    13731401      ENDIF 
    1374       ! 
    13751402   END SUBROUTINE iom_context_finalize 
    13761403 
     
    13811408      !! 
    13821409      !! ** Purpose :   define horizontal grids 
    1383       !! 
    13841410      !!---------------------------------------------------------------------- 
    13851411      CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd 
     
    13871413      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    13881414      ! 
     1415      INTEGER  :: ni,nj 
    13891416      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    1390       INTEGER  :: ni,nj 
    1391        
     1417      !!---------------------------------------------------------------------- 
     1418      ! 
    13921419      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
    1393  
     1420      ! 
    13941421      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    13951422      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    13961423      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    13971424         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    1398  
     1425      ! 
    13991426      IF ( ln_mskland ) THEN 
    14001427         ! mask land points, keep values on coast line -> specific mask for U, V and W points 
     
    14091436         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
    14101437      ENDIF 
    1411        
     1438      ! 
    14121439   END SUBROUTINE set_grid 
    14131440 
     
    14201447      !! 
    14211448      !!---------------------------------------------------------------------- 
    1422       CHARACTER(LEN=1) , INTENT(in) :: cdgrd 
    1423       ! 
    1424       REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 
    1425       REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j) 
    1426       ! 
    1427       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    1428       REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells 
    1429       REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells 
    1430       ! 
    1431       INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    1432       !                                                          ! represents the bottom-left corner of cell (i,j) 
     1449      CHARACTER(LEN=1)                      , INTENT(in) :: cdgrd 
     1450      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) :: plon_cnr, plat_cnr  ! Lat/lon coord. of a contiguous vertex of cell (i,j) 
     1451      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j) 
     1452      ! 
    14331453      INTEGER :: ji, jj, jn, ni, nj 
    1434  
     1454      INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     1455      !                                                        ! represents the bottom-left corner of cell (i,j) 
     1456      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
     1457      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
     1458      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_rot       ! Lat/lon working array for rotation of cells 
     1459      !!---------------------------------------------------------------------- 
     1460      ! 
    14351461      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  ) 
    1436  
     1462      ! 
    14371463      ! Offset of coordinate representing bottom-left corner 
    14381464      SELECT CASE ( TRIM(cdgrd) ) 
    1439          CASE ('T', 'W') 
    1440             icnr = -1 ; jcnr = -1 
    1441          CASE ('U') 
    1442             icnr =  0 ; jcnr = -1 
    1443          CASE ('V') 
    1444             icnr = -1 ; jcnr =  0 
     1465      CASE ('T', 'W')   ;   icnr = -1   ;   jcnr = -1 
     1466      CASE ('U')        ;   icnr =  0   ;   jcnr = -1 
     1467      CASE ('V')        ;   icnr = -1   ;   jcnr =  0 
    14451468      END SELECT 
    1446  
     1469      ! 
    14471470      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior 
    1448  
     1471      ! 
    14491472      z_fld(:,:) = 1._wp 
    14501473      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold 
    1451  
     1474      ! 
    14521475      ! Cell vertices that can be defined 
    14531476      DO jj = 2, jpjm1 
     
    14631486         END DO 
    14641487      END DO 
    1465  
     1488      ! 
    14661489      ! Cell vertices on boundries 
    14671490      DO jn = 1, 4 
     
    14691492         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
    14701493      END DO 
    1471  
     1494      ! 
    14721495      ! Zero-size cells at closed boundaries if cell points provided, 
    14731496      ! otherwise they are closed cells with unrealistic bounds 
     
    14941517         ENDIF 
    14951518      ENDIF 
    1496  
    1497       ! Rotate cells at the north fold 
    1498       IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 
     1519      ! 
     1520      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN    ! Rotate cells at the north fold 
    14991521         DO jj = 1, jpj 
    15001522            DO ji = 1, jpi 
     
    15061528            END DO 
    15071529         END DO 
    1508  
    1509       ! Invert cells at the symmetric equator 
    1510       ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 
     1530      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN                  ! Invert cells at the symmetric equator 
    15111531         DO ji = 1, jpi 
    15121532            z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
     
    15151535         END DO 
    15161536      ENDIF 
    1517  
     1537      ! 
    15181538      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
    1519                                                bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
    1520  
     1539          &                                    bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
     1540      ! 
    15211541      DEALLOCATE( z_bnds, z_fld, z_rot )  
    1522  
     1542      ! 
    15231543   END SUBROUTINE set_grid_bounds 
    15241544 
     
    15351555      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    15361556      INTEGER  :: ni,nj, ix, iy 
    1537  
    1538        
     1557      !!---------------------------------------------------------------------- 
     1558      ! 
    15391559      ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk) 
    15401560      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
    1541  
    1542       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1561      ! 
     1562      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     1563!      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    15431564      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    15441565      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     
    15511572   END SUBROUTINE set_grid_znl 
    15521573 
     1574 
    15531575   SUBROUTINE set_scalar 
    15541576      !!---------------------------------------------------------------------- 
     
    15601582      REAL(wp), DIMENSION(1)   ::   zz = 1. 
    15611583      !!---------------------------------------------------------------------- 
    1562  
     1584      ! 
    15631585      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 
    15641586      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
    1565        
    1566       zz=REAL(narea,wp) 
     1587      ! 
     1588      zz = REAL( narea, wp ) 
    15671589      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    1568  
     1590      ! 
    15691591   END SUBROUTINE set_scalar 
    15701592 
     
    16371659      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 
    16381660      CALL set_mooring( zlonpira, zlatpira ) 
    1639  
    1640        
     1661      ! 
    16411662   END SUBROUTINE set_xmlatt 
    16421663 
    16431664 
    1644    SUBROUTINE set_mooring( plon, plat) 
     1665   SUBROUTINE set_mooring( plon, plat ) 
    16451666      !!---------------------------------------------------------------------- 
    16461667      !!                     ***  ROUTINE set_mooring  *** 
     
    16491670      !! 
    16501671      !!---------------------------------------------------------------------- 
    1651       REAL(wp), DIMENSION(:), INTENT(in) ::  plon, plat           ! longitudes/latitudes oft the mooring 
     1672      REAL(wp), DIMENSION(:), INTENT(in) ::   plon, plat   ! longitudes/latitudes oft the mooring 
    16521673      ! 
    16531674!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name 
     
    17981819               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    17991820            END DO 
    1800  
     1821            ! 
    18011822            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    18021823            DO WHILE ( idx /= 0 )  
     
    18051826               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    18061827            END DO 
    1807  
     1828            ! 
    18081829            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    18091830            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    18101831            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname ) 
    1811  
    1812          ENDIF 
    1813  
     1832            ! 
     1833         ENDIF 
     1834         ! 
    18141835      END DO 
    1815  
     1836      ! 
    18161837   END SUBROUTINE iom_update_file_name 
    18171838 
     
    18221843      !! 
    18231844      !! ** Purpose :   send back the date corresponding to the given julian day 
    1824       !! 
    18251845      !!---------------------------------------------------------------------- 
    18261846      REAL(wp), INTENT(in   )           ::   pjday         ! julian day 
     
    18331853      REAL(wp)          ::   zsec 
    18341854      LOGICAL           ::   ll24, llfull 
     1855      !!---------------------------------------------------------------------- 
    18351856      ! 
    18361857      IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24 
    18371858      ELSE                       ;   ll24 = .FALSE. 
    18381859      ENDIF 
    1839  
     1860      ! 
    18401861      IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull 
    18411862      ELSE                         ;   llfull = .FALSE. 
    18421863      ENDIF 
    1843  
     1864      ! 
    18441865      CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 
    18451866      isec = NINT(zsec) 
    1846  
     1867      ! 
    18471868      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day 
    18481869         CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 
    18491870         isec = 86400 
    18501871      ENDIF 
    1851  
     1872      ! 
    18521873      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date  
    18531874      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 
    18541875      ENDIF 
    1855        
     1876      ! 
    18561877!$AGRIF_DO_NOT_TREAT       
    1857 ! Should be fixed in the conv 
     1878      ! needed in the conv 
    18581879      IF( llfull ) THEN  
    18591880         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 
     
    18671888      ENDIF 
    18681889!$AGRIF_END_DO_NOT_TREAT       
    1869  
     1890      ! 
    18701891   END FUNCTION iom_sdate 
    18711892 
    18721893#else 
    1873  
    18741894 
    18751895   SUBROUTINE iom_setkt( kt, cdname ) 
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r7646 r8817  
    11MODULE iom_def 
    2    !!===================================================================== 
     2   !!====================================================================== 
    33   !!                    ***  MODULE  iom_def *** 
    44   !! IOM variables definitions 
    5    !!==================================================================== 
    6    !! History :  9.0  ! 06 09  (S. Masson) Original code 
    7    !!             "   ! 07 07  (D. Storkey) Add uldname 
    8    !!-------------------------------------------------------------------- 
    9    !!--------------------------------------------------------------------------------- 
    10    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    11    !! $Id$ 
    12    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    13    !!--------------------------------------------------------------------------------- 
    14  
     5   !!====================================================================== 
     6   !! History :  9.0  ! 2006 09  (S. Masson) Original code 
     7   !!             -   ! 2007 07  (D. Storkey) Add uldname 
     8   !!            4.0  ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 
     9   !!---------------------------------------------------------------------- 
    1510   USE par_kind 
    1611 
     
    6459      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    6560      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 
     61      INTEGER                                   ::   nlev     ! number of vertical levels 
    6662   END TYPE file_descriptor 
    6763   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 
    6864!$AGRIF_END_DO_NOT_TREAT 
    6965 
    70    !!===================================================================== 
     66   !!---------------------------------------------------------------------- 
     67   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     68   !! $Id$ 
     69   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     70   !!====================================================================== 
    7171END MODULE iom_def 
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r7646 r8817  
    11MODULE iom_nf90 
    2    !!===================================================================== 
     2   !!====================================================================== 
    33   !!                    ***  MODULE  iom_nf90 *** 
    44   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module) 
    5    !!==================================================================== 
     5   !!====================================================================== 
    66   !! History :  9.0  ! 05 12  (J. Belier) Original code 
    77   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
    88   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime 
    99   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes 
    10    !!-------------------------------------------------------------------- 
    11    !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
    12  
    13    !!-------------------------------------------------------------------- 
     10   !!            4.0  ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 
     11   !!---------------------------------------------------------------------- 
     12 
     13   !!---------------------------------------------------------------------- 
    1414   !!   iom_open       : open a file read only 
    1515   !!   iom_close      : close a file or all files opened by iom 
     
    1818   !!   iom_varid      : get the id of a variable in a file 
    1919   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    20    !!-------------------------------------------------------------------- 
     20   !!---------------------------------------------------------------------- 
    2121   USE dom_oce         ! ocean space and time domain 
    2222   USE lbclnk          ! lateal boundary condition / mpp exchanges 
     
    2929   PRIVATE 
    3030 
    31    PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput 
     31   PUBLIC iom_nf90_open  , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput 
    3232   PUBLIC iom_nf90_getatt, iom_nf90_putatt 
    3333 
     
    4646 
    4747   !!---------------------------------------------------------------------- 
    48    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     48   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4949   !! $Id$ 
    5050   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 
    52  
    5352CONTAINS 
    5453 
    55    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar ) 
     54   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev ) 
    5655      !!--------------------------------------------------------------------- 
    5756      !!                   ***  SUBROUTINE  iom_open  *** 
     
    6463      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    6564      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
     65      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension 
    6666 
    6767      CHARACTER(LEN=256) ::   clinfo           ! info character 
     
    7676      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7777      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
    78       !--------------------------------------------------------------------- 
    79  
     78      INTEGER            ::   ilevels           ! vertical levels 
     79      !--------------------------------------------------------------------- 
     80      ! 
    8081      clinfo = '                    iom_nf90_open ~~~  ' 
    81       istop = nstop   ! store the actual value of nstop 
     82      istop = nstop     ! store the actual value of nstop 
     83      ! 
     84      !                 !number of vertical levels 
     85      IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice) 
     86      ELSE                        ;   ilevels = jpk      ! by default jpk 
     87      ENDIF 
     88      ! 
    8289      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz 
    8390      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT 
     
    8592      ! 
    8693      llclobber = ldwrt .AND. ln_clobber 
    87       IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file... 
    88          !                 ! ============= 
     94      IF( ldok .AND. .NOT. llclobber ) THEN      !==  Open existing file ==! 
     95         !                                       !=========================! 
    8996         IF( ldwrt ) THEN  ! ... in write mode 
    9097            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode' 
     
    99106            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo) 
    100107         ENDIF 
    101       ELSE                                       ! the file does not exist (or we overwrite it) 
    102          !                 ! ============= 
     108      ELSE                                       !== the file doesn't exist ==!  (or we overwrite it) 
     109         !                                       !============================! 
    103110         iln = INDEX( cdname, '.nc' ) 
    104          IF( ldwrt ) THEN  ! the file should be open in write mode so we create it... 
     111         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it... 
    105112            IF( jpnij > 1 ) THEN 
    106113               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
     
    126133            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo) 
    127134            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo) 
     135            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', ilevels       , idmy ), clinfo) 
    129136            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo) 
    130137            ! global attributes 
     
    139146            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)       ), clinfo) 
    140147            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo) 
    141          ELSE              ! the file should be open for read mode so it must exist... 
     148         ELSE                          !* the file should be open for read mode so it must exist... 
    142149            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    143150         ENDIF 
    144151      ENDIF 
     152      ! 
    145153      ! start to fill file informations 
    146154      ! ============= 
     
    156164         iom_file(kiomid)%nvars  = 0 
    157165         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
     166         iom_file(kiomid)%nlev   = ilevels 
    158167         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    159          IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN 
    160            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     &  
    161         &                                               name = iom_file(kiomid)%uldname,  & 
    162         &                                               len  = iom_file(kiomid)%lenuld ), clinfo ) 
     168         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 
     169            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,    &  
     170               &                                       name = iom_file(kiomid)%uldname,   & 
     171               &                                       len  = iom_file(kiomid)%lenuld ), clinfo ) 
    163172         ENDIF 
    164173         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK' 
     
    179188      CHARACTER(LEN=100)  ::   clinfo   ! info character 
    180189      !--------------------------------------------------------------------- 
    181       ! 
    182190      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name) 
    183191      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo) 
    184       !     
    185192   END SUBROUTINE iom_nf90_close 
    186193 
     
    275282      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    276283      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
    277       !  
    278284   END SUBROUTINE iom_nf90_g0d 
    279285 
     
    357363         ivarid = NF90_GLOBAL 
    358364      ENDIF 
    359 ! 
     365      ! 
    360366      IF( llok) THEN 
    361367         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', giatt: '//TRIM(cdatt) 
     
    368374   END SUBROUTINE iom_nf90_giatt 
    369375 
    370    SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar) 
     376 
     377   SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar ) 
    371378      !!----------------------------------------------------------------------- 
    372379      !!                  ***  ROUTINE  iom_nf90_gratt  *** 
     
    376383      !!               attribute if optional variable name is supplied (cdvar)) 
    377384      !!----------------------------------------------------------------------- 
    378       INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
    379       CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
    380       REAL(wp)        , INTENT(  out) ::   pv_r0d   ! read field 
    381       CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
    382                       &               ::   cdvar    ! name of the variable 
    383       ! 
    384       INTEGER                         ::   if90id   ! temporary integer 
    385       INTEGER                         ::   ivarid   ! NetCDF variable Id 
    386       LOGICAL                         ::   llok     ! temporary logical 
    387       CHARACTER(LEN=100)              ::   clinfo   ! info character 
     385      INTEGER                   , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     386      CHARACTER(len=*)          , INTENT(in   ) ::   cdatt    ! attribute name 
     387      REAL(wp)                  , INTENT(  out) ::   pv_r0d   ! read field 
     388      CHARACTER(len=*), OPTIONAL, INTENT(in   ) ::   cdvar    ! name of the variable 
     389      ! 
     390      INTEGER            ::   if90id   ! temporary integer 
     391      INTEGER            ::   ivarid   ! NetCDF variable Id 
     392      LOGICAL            ::   llok     ! temporary logical 
     393      CHARACTER(LEN=100) ::   clinfo   ! info character 
    388394      !--------------------------------------------------------------------- 
    389395      ! 
     
    402408         ivarid = NF90_GLOBAL 
    403409      ENDIF 
    404 ! 
     410      ! 
    405411      IF( llok) THEN 
    406412         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gratt: '//TRIM(cdatt) 
     
    413419   END SUBROUTINE iom_nf90_gratt 
    414420 
    415    SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar) 
     421 
     422   SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar ) 
    416423      !!----------------------------------------------------------------------- 
    417424      !!                  ***  ROUTINE  iom_nf90_gcatt  *** 
     
    421428      !!               attribute if optional variable name is supplied (cdvar)) 
    422429      !!----------------------------------------------------------------------- 
    423       INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
    424       CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
    425       CHARACTER(len=*), INTENT(  out) ::   pv_c0d   ! read field 
    426       CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
    427                       &               ::   cdvar    ! name of the variable 
    428       ! 
    429       INTEGER                         ::   if90id   ! temporary integer 
    430       INTEGER                         ::   ivarid   ! NetCDF variable Id 
    431       LOGICAL                         ::   llok     ! temporary logical 
    432       CHARACTER(LEN=100)              ::   clinfo   ! info character 
     430      INTEGER                   , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     431      CHARACTER(len=*)          , INTENT(in   ) ::   cdatt    ! attribute name 
     432      CHARACTER(len=*)          , INTENT(  out) ::   pv_c0d   ! read field 
     433      CHARACTER(len=*), OPTIONAL, INTENT(in   ) ::   cdvar    ! name of the variable 
     434      ! 
     435      INTEGER            ::   if90id   ! temporary integer 
     436      INTEGER            ::   ivarid   ! NetCDF variable Id 
     437      LOGICAL            ::   llok     ! temporary logical 
     438      CHARACTER(LEN=100) ::   clinfo   ! info character 
    433439      !--------------------------------------------------------------------- 
    434440      ! 
     
    458464   END SUBROUTINE iom_nf90_gcatt 
    459465 
     466 
    460467   !!---------------------------------------------------------------------- 
    461468   !!                   INTERFACE iom_nf90_putatt 
     
    495502         ivarid = NF90_GLOBAL 
    496503      ENDIF 
    497 ! 
     504      ! 
    498505      IF( llok) THEN 
    499506         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', piatt: '//TRIM(cdatt) 
     
    517524   END SUBROUTINE iom_nf90_piatt 
    518525 
    519    SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar) 
     526 
     527   SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar ) 
    520528      !!----------------------------------------------------------------------- 
    521529      !!                  ***  ROUTINE  iom_nf90_pratt  *** 
     
    525533      !!               attribute if optional variable name is supplied (cdvar)) 
    526534      !!----------------------------------------------------------------------- 
    527       INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
    528       CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
    529       REAL(wp)        , INTENT(in   ) ::   pv_r0d   ! write field 
    530       CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
    531                       &               ::   cdvar    ! name of the variable 
    532       ! 
    533       INTEGER                         ::   if90id   ! temporary integer 
    534       INTEGER                         ::   ivarid   ! NetCDF variable Id 
    535       LOGICAL                         ::   llok     ! temporary logical 
    536       LOGICAL                         ::   lenddef  ! temporary logical 
    537       CHARACTER(LEN=100)              ::   clinfo   ! info character 
     535      INTEGER                   , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     536      CHARACTER(len=*)          , INTENT(in   ) ::   cdatt    ! attribute name 
     537      REAL(wp)                  , INTENT(in   ) ::   pv_r0d   ! write field 
     538      CHARACTER(len=*), OPTIONAL, INTENT(in   ) ::   cdvar    ! name of the variable 
     539      ! 
     540      INTEGER            ::   if90id   ! temporary integer 
     541      INTEGER            ::   ivarid   ! NetCDF variable Id 
     542      LOGICAL            ::   llok     ! temporary logical 
     543      LOGICAL            ::   lenddef  ! temporary logical 
     544      CHARACTER(LEN=100) ::   clinfo   ! info character 
    538545      !--------------------------------------------------------------------- 
    539546      ! 
     
    550557         ivarid = NF90_GLOBAL 
    551558      ENDIF 
    552 ! 
     559      ! 
    553560      IF( llok) THEN 
    554561         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pratt: '//TRIM(cdatt) 
     
    572579   END SUBROUTINE iom_nf90_pratt 
    573580 
    574    SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar) 
     581 
     582   SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar ) 
    575583      !!----------------------------------------------------------------------- 
    576584      !!                  ***  ROUTINE  iom_nf90_pcatt  *** 
     
    580588      !!               attribute if optional variable name is supplied (cdvar)) 
    581589      !!----------------------------------------------------------------------- 
    582       INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
    583       CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
    584       CHARACTER(len=*), INTENT(in   ) ::   pv_c0d   ! write field 
    585       CHARACTER(len=*), INTENT(in   ), OPTIONAL     & 
    586                       &               ::   cdvar    ! name of the variable 
    587       ! 
    588       INTEGER                         ::   if90id   ! temporary integer 
    589       INTEGER                         ::   ivarid   ! NetCDF variable Id 
    590       LOGICAL                         ::   llok     ! temporary logical 
    591       LOGICAL                         ::   lenddef  ! temporary logical 
    592       CHARACTER(LEN=100)              ::   clinfo   ! info character 
     590      INTEGER                   , INTENT(in   ) ::   kiomid   ! Identifier of the file 
     591      CHARACTER(len=*)          , INTENT(in   ) ::   cdatt    ! attribute name 
     592      CHARACTER(len=*)          , INTENT(in   ) ::   pv_c0d   ! write field 
     593      CHARACTER(len=*), OPTIONAL, INTENT(in   ) ::   cdvar    ! name of the variable 
     594      ! 
     595      INTEGER            ::   if90id   ! temporary integer 
     596      INTEGER            ::   ivarid   ! NetCDF variable Id 
     597      LOGICAL            ::   llok     ! temporary logical 
     598      LOGICAL            ::   lenddef  ! temporary logical 
     599      CHARACTER(LEN=100) ::   clinfo   ! info character 
    593600      !--------------------------------------------------------------------- 
    594601      ! 
     
    605612         ivarid = NF90_GLOBAL 
    606613      ENDIF 
    607 ! 
     614      ! 
    608615      IF( llok) THEN 
    609616         clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pcatt: '//TRIM(cdatt) 
     
    658665 
    659666   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
    660          &                               pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 
     667         &                                  pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 
    661668      !!-------------------------------------------------------------------- 
    662669      !!                   ***  SUBROUTINE  iom_nf90_rstput  *** 
     
    687694      INTEGER               :: itype                ! variable type 
    688695      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using 
    689                                                     ! nn_nchunks_[i,j,k,t] namelist parameters 
    690       INTEGER               :: ichunkalg, ishuffle,& 
    691                                ideflate, ideflate_level 
    692                                                     ! NetCDF4 internally fixed parameters 
     696      !                                             ! nn_nchunks_[i,j,k,t] namelist parameters 
     697      INTEGER               :: ichunkalg, ishuffle, ideflate, ideflate_level 
     698      !                                             ! NetCDF4 internally fixed parameters 
    693699      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression 
    694                                                     ! when appropriate (currently chunking is applied to 4d fields only) 
     700      !                                             ! when appropriate (currently chunking is applied to 4d fields only) 
     701      INTEGER               :: idlv                 ! local variable 
    695702      !--------------------------------------------------------------------- 
    696703      ! 
     
    706713         ENDIF 
    707714         ! define the dimension variables if it is not already done 
    708          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /) 
     715         IF(iom_file(kiomid)%nlev == jpk ) THEN 
     716          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /) 
     717         ELSE 
     718          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'numcat      ', 'time_counter' /) 
     719         ENDIF 
    709720         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 
    710721         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 
     
    755766         IF( PRESENT(pv_r0d) ) THEN 
    756767            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    & 
    757                  &                            iom_file(kiomid)%nvid(idvar) ), clinfo) 
     768               &                              iom_file(kiomid)%nvid(idvar) ), clinfo ) 
    758769         ELSE 
    759770            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   & 
    760                  &                            iom_file(kiomid)%nvid(idvar) ), clinfo) 
     771               &                              iom_file(kiomid)%nvid(idvar) ), clinfo ) 
    761772         ENDIF 
    762773         lchunk = .false. 
    763          IF( snc4set%luse .AND. idims.eq.4 ) lchunk = .true. 
     774         IF( snc4set%luse .AND. idims == 4 )  lchunk = .true. 
    764775         ! update informations structure related the new variable we want to add... 
    765776         iom_file(kiomid)%nvars         = idvar 
     
    782793            ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6 
    783794            ichunksz(4) = 1                                                            ! Do not allow chunks to span the 
    784                                                                                        ! unlimited dimension 
     795            !                                                                          ! unlimited dimension 
    785796            CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo) 
    786797            CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo) 
     
    791802         idvar = kvid 
    792803      ENDIF 
    793  
     804      ! 
    794805      ! time step kwrite : write the variable 
    795806      IF( kt == kwrite ) THEN 
     
    815826            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    816827            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    817                CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo) 
    818                CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo) 
    819                CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat'     , idmy ), clinfo) 
    820                CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo) 
    821                CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo) 
    822                CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d                ), clinfo) 
     828               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo ) 
     829               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
     830               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo ) 
     831               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
     832               IF(iom_file(kiomid)%nlev == jpk ) THEN  
     833                  !NEMO 
     834                  CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo ) 
     835                  CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo ) 
     836               ELSE 
     837                  CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'numcat'     , idmy ), clinfo) 
     838                  CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 
     839               ENDIF 
    823840               ! +++ WRONG VALUE: to be improved but not really useful... 
    824                CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo) 
    825                CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)    
     841               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 
     842               CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )    
    826843               ! update the values of the variables dimensions size 
    827                CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo) 
    828                CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo) 
     844               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 
     845               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 
    829846               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
    830                CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo) 
     847               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 
    831848               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
    832849               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
     
    837854         ! ============= 
    838855         IF(     PRESENT(pv_r0d) ) THEN 
    839             CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r0d                      ), clinfo) 
     856            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r0d                    ), clinfo ) 
    840857         ELSEIF( PRESENT(pv_r1d) ) THEN 
    841             CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r1d(                  :) ), clinfo) 
     858            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r1d(:)                 ), clinfo ) 
    842859         ELSEIF( PRESENT(pv_r2d) ) THEN 
    843             CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2   ) ), clinfo) 
     860            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2,iy1:iy2)   ), clinfo ) 
    844861         ELSEIF( PRESENT(pv_r3d) ) THEN 
    845             CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo) 
     862            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2,iy1:iy2,:) ), clinfo ) 
    846863         ENDIF 
    847864         ! add 1 to the size of the temporal dimension (not really useful...) 
Note: See TracChangeset for help on using the changeset viewer.