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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13710 for NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/IOM/iom_nf90.F90 – NEMO

Ignore:
Timestamp:
2020-11-02T10:56:42+01:00 (4 years ago)
Author:
emanuelaclementi
Message:

branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves: merge with trunk@13708, see #2155 and #2339

Location:
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/IOM/iom_nf90.F90

    r12649 r13710  
    3333 
    3434   INTERFACE iom_nf90_get 
    35       MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d 
     35      MODULE PROCEDURE iom_nf90_g0d_sp                    
     36      MODULE PROCEDURE iom_nf90_g0d_dp, iom_nf90_g123d_dp 
    3637   END INTERFACE 
    3738   INTERFACE iom_nf90_rstput 
    38       MODULE PROCEDURE iom_nf90_rp0123d 
     39      MODULE PROCEDURE iom_nf90_rp0123d_dp 
    3940   END INTERFACE 
    4041 
    … …  
    4647CONTAINS 
    4748 
    48    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 
     49   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdlev, cdcomp ) 
    4950      !!--------------------------------------------------------------------- 
    5051      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    5657      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file? 
    5758      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    58       INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    5959      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
    6060      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    … …  
    6262      CHARACTER(LEN=256) ::   clinfo           ! info character 
    6363      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
     64      CHARACTER(LEN=12 ) ::   clfmt            ! writing format 
    6465      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open 
     66      INTEGER            ::   idg              ! number of digits 
    6567      INTEGER            ::   iln              ! lengths of character 
    6668      INTEGER            ::   istop            ! temporary storage of nstop 
    … …  
    109111         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it... 
    110112            IF( jpnij > 1 ) THEN 
    111                WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
     113               idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     114               WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     115               WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 
    112116               cdname = TRIM(cltmp) 
    113117            ENDIF 
    … …  
    129133            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    130134            ! define dimensions 
    131                                CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    132                                CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
     135                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',  Ni_0, idmy ), clinfo) 
     136                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',  Nj_0, idmy ), clinfo) 
    133137            SELECT CASE (clcomp) 
    134             CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
    135             CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat',          kdlev, idmy ), clinfo) 
    136             CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',          kdlev, idmy ), clinfo) 
    137             CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed',          kdlev, idmy ), clinfo) 
     138            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',   jpk, idmy ), clinfo) 
     139            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat', kdlev, idmy ), clinfo) 
     140            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev', kdlev, idmy ), clinfo) 
     141            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed', kdlev, idmy ), clinfo) 
    138142            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' ) 
    139143            END SELECT 
    140144                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    141145            ! global attributes 
    142             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
    143             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo) 
    144             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo) 
    145             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo) 
    146             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)      ), clinfo) 
    147             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)      ), clinfo) 
    148             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)      ), clinfo) 
    149             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)      ), clinfo) 
    150             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)      ), clinfo) 
    151             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo) 
     146            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij                        ), clinfo) 
     147            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1                      ), clinfo) 
     148            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1        , 2           /) ), clinfo) 
     149            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/ Ni0glo    , Nj0glo     /) ), clinfo) 
     150            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , (/ Ni_0      , Nj_0       /) ), clinfo) 
     151            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ), clinfo) 
     152            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , (/ mig0(Nie0), mjg0(Nje0) /) ), clinfo) 
     153            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0         , 0          /) ), clinfo) 
     154            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/ 0         , 0          /) ), clinfo) 
     155            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'                        ), clinfo) 
    152156         ELSE                          !* the file should be open for read mode so it must exist... 
    153157            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    … …  
    272276   !!---------------------------------------------------------------------- 
    273277 
    274    SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart ) 
     278   SUBROUTINE iom_nf90_g0d_sp( kiomid, kvid, pvar, kstart ) 
    275279      !!----------------------------------------------------------------------- 
    276280      !!                  ***  ROUTINE  iom_nf90_g0d  *** 
    … …  
    280284      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file 
    281285      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id 
    282       REAL(wp),               INTENT(  out)            ::   pvar     ! read field 
     286      REAL(sp),               INTENT(  out)            ::   pvar     ! read field 
    283287      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis 
    284288      ! 
    … …  
    287291      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    288292      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
    289    END SUBROUTINE iom_nf90_g0d 
    290  
    291  
    292    SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
     293   END SUBROUTINE iom_nf90_g0d_sp 
     294 
     295   SUBROUTINE iom_nf90_g0d_dp( kiomid, kvid, pvar, kstart ) 
     296      !!----------------------------------------------------------------------- 
     297      !!                  ***  ROUTINE  iom_nf90_g0d  *** 
     298      !! 
     299      !! ** Purpose : read a scalar with NF90 
     300      !!----------------------------------------------------------------------- 
     301      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file 
     302      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id 
     303      REAL(dp),               INTENT(  out)            ::   pvar     ! read field 
     304      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis 
     305      ! 
     306      CHARACTER(LEN=100)      ::   clinfo   ! info character 
     307      !--------------------------------------------------------------------- 
     308      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
     309      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
     310   END SUBROUTINE iom_nf90_g0d_dp 
     311 
     312   SUBROUTINE iom_nf90_g123d_dp( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
    293313         &                    pv_r1d, pv_r2d, pv_r3d ) 
    294314      !!----------------------------------------------------------------------- 
    … …  
    305325      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis 
    306326      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    307       REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
    308       REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
    309       REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     327      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
     328      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
     329      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
    310330      ! 
    311331      CHARACTER(LEN=100) ::   clinfo               ! info character 
    … …  
    328348      ENDIF 
    329349      ! 
    330    END SUBROUTINE iom_nf90_g123d 
     350   END SUBROUTINE iom_nf90_g123d_dp 
     351 
    331352 
    332353 
    … …  
    502523   END SUBROUTINE iom_nf90_putatt 
    503524 
    504  
    505    SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
     525   SUBROUTINE iom_nf90_rp0123d_dp( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
    506526         &                                  pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 
    507527      !!-------------------------------------------------------------------- 
    … …  
    516536      INTEGER                     , INTENT(in)           ::   kvid     ! variable id 
    517537      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8) 
    518       REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field 
    519       REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
    520       REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
    521       REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
     538      REAL(dp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field 
     539      REAL(dp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
     540      REAL(dp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
     541      REAL(dp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
    522542      ! 
    523543      INTEGER               :: idims                ! number of dimension 
    … …  
    651671         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN 
    652672            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar) 
    653             IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN 
    654                ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej 
    655             ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN 
    656                ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj 
    657             ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN 
     673            IF(     idimsz(1) == Ni_0 .AND. idimsz(2) == Nj_0 ) THEN 
     674               ix1 = Nis0   ;   ix2 = Nie0   ;   iy1 = Njs0   ;   iy2 = Nje0 
     675            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
     676               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
     677            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
    658678               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    659679            ELSE  
    … …  
    700720      ENDIF 
    701721      !      
    702    END SUBROUTINE iom_nf90_rp0123d 
     722   END SUBROUTINE iom_nf90_rp0123d_dp 
    703723 
    704724 
Note: See TracChangeset for help on using the changeset viewer.