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 550 – NEMO

Changeset 550


Ignore:
Timestamp:
2006-10-25T15:43:58+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_bugfix_065: SM: iom bugfix for agrif + others...

Location:
trunk/NEMO/OPA_SRC/IOM
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r548 r550  
    1616   USE par_oce 
    1717   USE lib_print         ! formated print library 
     18   USE iom_def           ! iom variables definitions 
    1819 
    1920   IMPLICIT NONE 
    … …  
    3334   INTEGER            ::   nleapy     = 0         !: Leap year calendar flag (0/1 or 30) 
    3435   INTEGER            ::   ninist     = 0         !: initial state output flag (0/1) 
     36   INTEGER            ::   nbench     = 0         !: benchmark parameter (0/1) 
    3537    
    3638   !!---------------------------------------------------------------------- 
    … …  
    4749   INTEGER            ::   jsplt      =    1      !: number of processors following j 
    4850   INTEGER            ::   ijsplt     =    1      !: nb of local domain = nb of processors 
    49    INTEGER            ::   nbench     = 0         !: benchmark parameter (0/1) 
    50    INTEGER            ::   nbit_cmp   = 0         !: bit reproducibility  (0/1) 
    5151 
    5252   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/IOM/iom.F90

    r547 r550  
    1313   !!   iom_close      : close a file or all files opened by iom 
    1414   !!   iom_get        : read a field (interfaced to several routines) 
    15    !!   iom_gettime    : read the time axis cdvar in the file               !!gm : never call ?????? 
     15   !!   iom_gettime    : read the time axis cdvar in the file 
    1616   !!   iom_varid      : get the id of a variable in a file 
    1717   !!   iom_rstput     : write a field in a restart file (interfaced to several routines) 
    … …  
    2525 
    2626   IMPLICIT NONE 
    27    PUBLIC   !   must be PUBLIC to pass the variables through the modules 
    28  
     27   PRIVATE 
     28    
    2929   PUBLIC iom_open, iom_close, iom_varid, iom_get, iom_gettime, iom_rstput 
    30    PRIVATE iom_get_0d, iom_get_1d, iom_get_2d, iom_get_3d, iom_get_123d 
    31    PRIVATE iom_rstput_0d, iom_rstput_1d, iom_rstput_2d, iom_rstput_3d 
    3230 
    3331   INTERFACE iom_get 
    34       MODULE PROCEDURE iom_get_0d, iom_get_1d, iom_get_2d, iom_get_3d 
     32      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d 
    3533   END INTERFACE 
    3634   INTERFACE iom_rstput 
    37       MODULE PROCEDURE iom_rstput_0d, iom_rstput_1d, iom_rstput_2d, iom_rstput_3d 
     35      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    3836   END INTERFACE 
    3937 
    40    INTEGER, PRIVATE ::   iom_init = 0 !  
     38   INTEGER ::   iom_init = 0 !  
    4139   !!---------------------------------------------------------------------- 
    4240   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    … …  
    6260      CHARACTER(LEN=100)    ::   cltmpn    ! tempory name to store clname (in writting mode) 
    6361      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg" 
    64       CHARACTER(LEN=10)     ::   clcpu     ! the cpu number (max jpmax_digits digits) 
     62      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits) 
    6563      CHARACTER(LEN=100)    ::   clinfo    ! info character 
    6664      LOGICAL               ::   llok      ! check the existence  
    … …  
    290288   !!                   INTERFACE iom_get 
    291289   !!---------------------------------------------------------------------- 
    292    SUBROUTINE iom_get_0d( kiomid, cdvar, pvar ) 
     290   SUBROUTINE iom_g0d( kiomid, cdvar, pvar ) 
    293291      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    294292      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
    … …  
    304302         CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar ) 
    305303         CASE DEFAULT     
    306             CALL ctl_stop( 'iom_get_0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     304            CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    307305         END SELECT 
    308306      END IF 
    309    END SUBROUTINE iom_get_0d 
    310  
    311    SUBROUTINE iom_get_1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     307   END SUBROUTINE iom_g0d 
     308 
     309   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
    312310      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    313311      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    … …  
    320318      IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   & 
    321319            &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
    322    END SUBROUTINE iom_get_1d 
    323  
    324    SUBROUTINE iom_get_2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     320   END SUBROUTINE iom_g1d 
     321 
     322   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
    325323      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    326324      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    … …  
    333331      IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    334332            &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
    335    END SUBROUTINE iom_get_2d 
    336  
    337    SUBROUTINE iom_get_3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     333   END SUBROUTINE iom_g2d 
     334 
     335   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
    338336      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    339337      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    … …  
    346344      IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    347345            &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
    348    END SUBROUTINE iom_get_3d 
     346   END SUBROUTINE iom_g3d 
    349347   !!---------------------------------------------------------------------- 
    350348 
    … …  
    607605            IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs 
    608606         ELSEIF( PRESENT(pv_r2d) ) THEN 
    609             !CDIR COLLAPSE 
     607!CDIR COLLAPSE 
    610608            IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf 
    611             !CDIR COLLAPSE 
     609!CDIR COLLAPSE 
    612610            IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs 
    613611         ELSEIF( PRESENT(pv_r3d) ) THEN 
    614             !CDIR COLLAPSE 
     612!CDIR COLLAPSE 
    615613            IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 
    616             !CDIR COLLAPSE 
     614!CDIR COLLAPSE 
    617615            IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 
    618616         ENDIF 
    … …  
    672670   !!                   INTERFACE iom_rstput 
    673671   !!---------------------------------------------------------------------- 
    674    SUBROUTINE iom_rstput_0d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     672   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
    675673      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    676674      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    687685         CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, pvar ) 
    688686         CASE DEFAULT      
    689             CALL ctl_stop( 'iom_rstput_0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     687            CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    690688         END SELECT 
    691689      END IF 
    692    END SUBROUTINE iom_rstput_0d 
    693  
    694    SUBROUTINE iom_rstput_1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     690   END SUBROUTINE iom_rp0d 
     691 
     692   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
    695693      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    696694      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    707705         CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r1d = pvar ) 
    708706         CASE DEFAULT      
    709             CALL ctl_stop( 'iom_rstput_1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     707            CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    710708         END SELECT 
    711709      END IF 
    712    END SUBROUTINE iom_rstput_1d 
    713  
    714    SUBROUTINE iom_rstput_2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     710   END SUBROUTINE iom_rp1d 
     711 
     712   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
    715713      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    716714      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    727725         CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r2d = pvar )  
    728726         CASE DEFAULT      
    729             CALL ctl_stop( 'iom_rstput_2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     727            CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    730728         END SELECT 
    731729      END IF 
    732    END SUBROUTINE iom_rstput_2d 
    733  
    734    SUBROUTINE iom_rstput_3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     730   END SUBROUTINE iom_rp2d 
     731 
     732   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
    735733      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    736734      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    747745         CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r3d = pvar ) 
    748746         CASE DEFAULT      
    749             CALL ctl_stop( 'iom_rstput_3d: accepted IO library are only jpioipsl and jprstdimg' ) 
     747            CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' ) 
    750748         END SELECT 
    751749      END IF 
    752    END SUBROUTINE iom_rstput_3d 
     750   END SUBROUTINE iom_rp3d 
    753751   !!---------------------------------------------------------------------- 
    754752 

  • trunk/NEMO/OPA_SRC/IOM/iom_def.F90

    r547 r550  
    3939   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 
    4040 
    41    !$AGRIF_DO_NOT_TREAT 
     41!$AGRIF_DO_NOT_TREAT 
    4242   TYPE, PUBLIC ::   flio_file 
    4343      CHARACTER(LEN=240)                        ::   name     !: name of the file 
    … …  
    5656   END TYPE flio_file 
    5757   TYPE(flio_file), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 
    58    !$AGRIF_END_DO_NOT_TREAT 
     58!$AGRIF_END_DO_NOT_TREAT 
    5959 
    6060   !!===================================================================== 

  • trunk/NEMO/OPA_SRC/IOM/iom_ioipsl.F90

    r547 r550  
    2020   USE dom_oce         ! ocean space and time domain 
    2121   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    22  
    23  
    2422   USE ioipsl          ! IOIPSL library 
    25    USE iom_def         !  
    2623 
    2724   IMPLICIT NONE 
    … …  
    3128 
    3229   INTERFACE iom_ioipsl_get 
    33       MODULE PROCEDURE iom_ioipsl_get_0d, iom_ioipsl_get_123d 
     30      MODULE PROCEDURE iom_ioipsl_g0d, iom_ioipsl_g123d 
    3431   END INTERFACE 
    3532   INTERFACE iom_ioipsl_rstput 
    36       MODULE PROCEDURE iom_ioipsl_rstput_0123d 
     33      MODULE PROCEDURE iom_ioipsl_rp0123d 
    3734   END INTERFACE 
    3835   !!---------------------------------------------------------------------- 
    … …  
    7976         iln = INDEX( cdname, '.nc' ) 
    8077         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it... 
    81             ! define the domain position regarding to the global domain (mainly useful in mpp) 
    82             CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/)   & 
    83                   &                 , kdompar(:,1), kdompar(:,2), kdompar(:,3), kdompar(:,4), kdompar(:,5)   & 
    84                   &                 , 'BOX', ifliodom )         
    85             ! Note that fliocrfd may change the value of cdname (add the cpu number...) 
    86             IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname(1:iln-1)//'... in WRITE mode' 
    87             CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   & 
    88                   &              , (/kdompar(1,1), kdompar(2,1), jpk, -1 /)   & 
    89                   &              , ioipslid, ifliodom ) 
     78            IF( jpnij > 1 ) THEN 
     79               ! define the domain position regarding to the global domain (mainly useful in mpp) 
     80               CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/)   & 
     81                  &             , kdompar(:,1), kdompar(:,2), kdompar(:,3), kdompar(:,4), kdompar(:,5)   & 
     82                  &             , 'BOX', ifliodom )         
     83               ! Note that fliocrfd may change the value of cdname (add the cpu number...) 
     84               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname(1:iln-1)//'... in WRITE mode' 
     85               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   & 
     86                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, ifliodom ) 
     87            ELSE              ! the file should be open for read mode so it must exist... 
     88               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname//' in WRITE mode' 
     89               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   & 
     90                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid ) 
     91            ENDIF 
    9092         ELSE              ! the file should be open for read mode so it must exist... 
    9193            CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' ) 
    … …  
    195197 
    196198 
    197    SUBROUTINE iom_ioipsl_get_0d( kiomid, kvid, pvar ) 
    198       !!----------------------------------------------------------------------- 
    199       !!                  ***  ROUTINE  iom_ioipsl_get_0d  *** 
     199   SUBROUTINE iom_ioipsl_g0d( kiomid, kvid, pvar ) 
     200      !!----------------------------------------------------------------------- 
     201      !!                  ***  ROUTINE  iom_ioipsl_g0d  *** 
    200202      !! 
    201203      !! ** Purpose : read a scalar with IOIPSL (only fliocom module) 
    … …  
    207209      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), pvar ) 
    208210      !  
    209    END SUBROUTINE iom_ioipsl_get_0d 
    210  
    211  
    212    SUBROUTINE iom_ioipsl_get_123d( kiomid, kdom, kvid, knbdim, kstart, kcount,    & 
     211   END SUBROUTINE iom_ioipsl_g0d 
     212 
     213 
     214   SUBROUTINE iom_ioipsl_g123d( kiomid, kdom, kvid, knbdim, kstart, kcount,    & 
    213215         &                          pv_r1d, pv_r2d, pv_r3d) 
    214216      !!----------------------------------------------------------------------- 
    215       !!                  ***  ROUTINE  iom_ioipsl_get_123d  *** 
     217      !!                  ***  ROUTINE  iom_ioipsl_g123d  *** 
    216218      !! 
    217219      !! ** Purpose : read a 1D/2D/3D variable with IOIPSL (only fliocom module) 
    … …  
    263265      ! 
    264266      ! 
    265    END SUBROUTINE iom_ioipsl_get_123d 
     267   END SUBROUTINE iom_ioipsl_g123d 
    266268 
    267269 
    … …  
    283285 
    284286 
    285    SUBROUTINE iom_ioipsl_rstput_0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
     287   SUBROUTINE iom_ioipsl_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
    286288         &                                 pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 
    287289      !!-------------------------------------------------------------------- 
    … …  
    311313      !--------------------------------------------------------------------- 
    312314      ! 
    313       clinfo = '          iom_ioipsl_rstput_0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar) 
     315      clinfo = '          iom_ioipsl_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar) 
    314316      ioipslid = iom_file(kiomid)%nfid 
    315317      ! 
    … …  
    395397               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    396398            ELSE  
    397                CALL ctl_stop( 'iom_ioipsl_rstput_0123d: should have been an impossible case...' ) 
     399               CALL ctl_stop( 'iom_ioipsl_rp0123d: should have been an impossible case...' ) 
    398400            ENDIF 
    399401 
    … …  
    423425      ENDIF 
    424426      !      
    425    END SUBROUTINE iom_ioipsl_rstput_0123d 
     427   END SUBROUTINE iom_ioipsl_rp0123d 
    426428 
    427429 

  • trunk/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r547 r550  
    2020   USE dom_oce         ! ocean space and time domain 
    2121   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    22  
    23  
    2422   USE netcdf          ! NetCDF library 
    25    USE iom_def         !  
    2623 
    2724   IMPLICIT NONE 
    … …  
    3128 
    3229   INTERFACE iom_nf90_get 
    33       MODULE PROCEDURE iom_nf90_get_0d, iom_nf90_get_123d 
     30      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d 
    3431   END INTERFACE 
    3532   INTERFACE iom_nf90_rstput 
    36       MODULE PROCEDURE iom_nf90_rstput_0123d 
     33      MODULE PROCEDURE iom_nf90_rp0123d 
    3734   END INTERFACE 
    3835   !!---------------------------------------------------------------------- 
    … …  
    8178         iln = INDEX( cdname, '.nc' ) 
    8279         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it... 
    83             WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
    84             cdname = TRIM(cltmp) 
     80            IF( jpnij > 1 ) THEN 
     81               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
     82               cdname = TRIM(cltmp) 
     83            ENDIF 
    8584            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode' 
    8685            CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), NF90_NOCLOBBER, if90id ), clinfo) 
    … …  
    208207 
    209208 
    210    SUBROUTINE iom_nf90_get_0d( kiomid, kvid, pvar ) 
    211       !!----------------------------------------------------------------------- 
    212       !!                  ***  ROUTINE  iom_nf90_get_0d  *** 
     209   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar ) 
     210      !!----------------------------------------------------------------------- 
     211      !!                  ***  ROUTINE  iom_nf90_g0d  *** 
    213212      !! 
    214213      !! ** Purpose : read a scalar with NF90 
    … …  
    220219      CHARACTER(LEN=100)      ::   clinfo   ! info character 
    221220      !--------------------------------------------------------------------- 
    222       clinfo = 'iom_nf90_get_0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
     221      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    223222      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar), clinfo ) 
    224223      !  
    225    END SUBROUTINE iom_nf90_get_0d 
    226  
    227  
    228    SUBROUTINE iom_nf90_get_123d( kiomid, kdom, kvid, knbdim, kstart, kcount,    & 
     224   END SUBROUTINE iom_nf90_g0d 
     225 
     226 
     227   SUBROUTINE iom_nf90_g123d( kiomid, kdom, kvid, knbdim, kstart, kcount,    & 
    229228         &                          pv_r1d, pv_r2d, pv_r3d) 
    230229      !!----------------------------------------------------------------------- 
    231       !!                  ***  ROUTINE  iom_nf90_get_123d  *** 
     230      !!                  ***  ROUTINE  iom_nf90_g123d  *** 
    232231      !! 
    233232      !! ** Purpose : read a 1D/2D/3D variable with NF90 
    … …  
    249248      INTEGER            ::   ivid     ! nf90 variable id 
    250249      !--------------------------------------------------------------------- 
    251       clinfo = 'iom_nf90_get_123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
     250      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    252251      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id 
    253252      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id 
    … …  
    281280      ENDIF 
    282281      ! 
    283    END SUBROUTINE iom_nf90_get_123d 
     282   END SUBROUTINE iom_nf90_g123d 
    284283 
    285284 
    … …  
    303302 
    304303 
    305    SUBROUTINE iom_nf90_rstput_0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
     304   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
    306305         &                               pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 
    307306      !!-------------------------------------------------------------------- 
    … …  
    334333      !--------------------------------------------------------------------- 
    335334      ! 
    336       clinfo = '          iom_nf90_rstput_0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar) 
     335      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar) 
    337336      if90id = iom_file(kiomid)%nfid 
    338337      ! 
    … …  
    428427               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    429428            ELSE  
    430                CALL ctl_stop( 'iom_nf90_rstput_0123d: should have been an impossible case...' ) 
     429               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' ) 
    431430            ENDIF 
    432431 
    … …  
    464463      ENDIF 
    465464      !      
    466    END SUBROUTINE iom_nf90_rstput_0123d 
     465   END SUBROUTINE iom_nf90_rp0123d 
    467466 
    468467 

  • trunk/NEMO/OPA_SRC/IOM/iom_rstdimg.F90

    r547 r550  
    1919   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2020 
    21    USE iom_def         !  
    22  
    2321   IMPLICIT NONE 
    2422   PRIVATE 
    … …  
    2725 
    2826   INTERFACE iom_rstdimg_get 
    29       MODULE PROCEDURE iom_rstdimg_get_0d, iom_rstdimg_get_123d 
     27      MODULE PROCEDURE iom_rstdimg_g0d, iom_rstdimg_g123d 
    3028   END INTERFACE 
    3129   INTERFACE iom_rstdimg_rstput 
    32       MODULE PROCEDURE iom_rstdimg_rstput_0d, iom_rstdimg_rstput_123d 
     30      MODULE PROCEDURE iom_rstdimg_rp0d, iom_rstdimg_rp123d 
    3331   END INTERFACE 
    3432   !!---------------------------------------------------------------------- 
    … …  
    6159      INTEGER                                 ::   ios                        ! IO status 
    6260      INTEGER                                 ::   ivnum                      ! number of variables 
     61      INTEGER                                 ::   ishft                      ! counter shift 
    6362      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable 
    64       INTEGER                                 ::   in0d, in2d, in3d           ! number of 0/2/3D variables 
     63      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables 
    6564      INTEGER                                 ::   ipni, ipnj, ipnij, iarea   ! domain decomposition  
    66       CHARACTER(LEN=8), DIMENSION(jpmax_vars) ::   clna0d, clna2d, clna3d     ! name of 0/2/3D variables 
    67       REAL(wp),         DIMENSION(jpmax_vars) ::   zval0d, zval2d, zval3d     ! value of 0d variables or 
    68       !                                                                       ! record position for 2/3D variables 
     65      CHARACTER(LEN=8), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables 
     66      REAL(wp),         DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record 
     67      !                                                                               ! position for 1/2/3D variables 
    6968      !--------------------------------------------------------------------- 
    7069 
    … …  
    8382         ! find the record length 
    8483         OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   & 
    85                &          , RECL = 8, STATUS = 'old', ACTION = 'read', IOSTAT = ios, ERR = 987 ) 
     84            &       , RECL = 8, STATUS = 'old', ACTION = 'read', IOSTAT = ios, ERR = 987 ) 
    8685         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8 
    8786         CLOSE( idrst ) 
    … …  
    9089            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READWRITE mode' 
    9190            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   & 
    92                   &          , RECL = irecl8, STATUS = 'old', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 ) 
     91               &       , RECL = irecl8, STATUS = 'old', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 ) 
    9392         ELSE              ! ... in read mode 
    9493            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode' 
    9594            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   & 
    96                   &          , RECL = irecl8, STATUS = 'old', ACTION = 'read'     , IOSTAT = ios, ERR = 987 ) 
     95               &       , RECL = irecl8, STATUS = 'old', ACTION = 'read'     , IOSTAT = ios, ERR = 987 ) 
    9796         ENDIF 
    9897      ELSE                 ! the file does not exist 
    … …  
    10099         IF( ldwrt ) THEN  ! the file should be open in readwrite mode so we create it... 
    101100            irecl8= kdompar(1,1) * kdompar(2,1) * wp 
    102             WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.dimg' 
    103             cdname = TRIM(cltmp) 
     101            IF( jpnij > 1 ) THEN 
     102               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.dimg' 
     103               cdname = TRIM(cltmp) 
     104            ENDIF 
    104105            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in READWRITE mode' 
    105106            OPEN( idrst, FILE = TRIM(cdname), FORM = 'UNFORMATTED', ACCESS = 'DIRECT'   & 
    106                   &          , RECL = irecl8, STATUS = 'new', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 ) 
     107               &       , RECL = irecl8, STATUS = 'new', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 ) 
    107108         ELSE              ! the file should be open for read mode so it must exist... 
    108109            CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' ) 
    … …  
    112113      ! ============= 
    113114      IF( ldok ) THEN      ! old file 
    114          READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in2d, in3d 
    115          READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in2d, in3d,   & 
    116                &   clna0d(1:in0d), zval0d(1:in0d), clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
    117                &   ipni, ipnj, ipnij, iarea  
     115         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d 
     116         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d,   & 
     117            &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
     118            &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
     119            &   ipni, ipnj, ipnij, iarea  
    118120         clinfo = TRIM(clinfo)//' file '//TRIM(cdname) 
    119121         IF( inx   /= kdompar(1,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in i direction' ) 
    … …  
    135137         IF( ldok ) THEN      ! old file 
    136138            ! read variables informations from the file header 
    137             ivnum = in0d + in2d + in3d 
     139            IF(  TRIM(clna0d(1)) == 'no0d' )   in0d = 0 
     140            IF(  TRIM(clna1d(1)) == 'no1d' )   in1d = 0 
     141            IF(  TRIM(clna2d(1)) == 'no2d' )   in2d = 0 
     142            IF(  TRIM(clna3d(1)) == 'no3d' )   in3d = 0 
     143            ivnum = in0d + in1d + in2d + in3d 
    138144            iom_file(kiomid)%nvars            = ivnum 
    139             iom_file(kiomid)%irec             = 2 + in2d + inz * in3d 
     145            iom_file(kiomid)%irec             = 2 + in1d + in2d + inz * in3d 
    140146            iom_file(kiomid)%luld(   1:ivnum) = .FALSE. 
    141147            iom_file(kiomid)%scf(    1:ivnum) = 1. 
    … …  
    147153               iom_file(kiomid)%ofs(   jv) = zval0d(jv)   ! warning: trick... we use ofs to store the value 
    148154            END DO 
     155            ! 1d variable 
     156            ishft = in0d 
     157            DO jv = 1, in1d 
     158               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna1d(jv)) 
     159               iom_file(kiomid)%nvid(      ishft + jv) = zval1d(jv) 
     160               iom_file(kiomid)%ndims(     ishft + jv) = 1 
     161               iom_file(kiomid)%dimsz(1  , ishft + jv) = jpk 
     162               iom_file(kiomid)%ofs(       ishft + jv) = 0. 
     163            END DO 
    149164            ! 2d variable 
     165            ishft = in0d + in1d 
    150166            DO jv = 1, in2d 
    151                iom_file(kiomid)%cn_var(    in0d + jv) = TRIM(clna2d(jv)) 
    152                iom_file(kiomid)%nvid(      in0d + jv) = zval2d(jv) 
    153                iom_file(kiomid)%ndims(     in0d + jv) = 2 
    154                iom_file(kiomid)%dimsz(1:2, in0d + jv) = (/ inx, iny /) 
    155                iom_file(kiomid)%ofs(       in0d + jv) = 0. 
     167               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna2d(jv)) 
     168               iom_file(kiomid)%nvid(      ishft + jv) = zval2d(jv) 
     169               iom_file(kiomid)%ndims(     ishft + jv) = 2 
     170               iom_file(kiomid)%dimsz(1:2, ishft + jv) = (/ inx, iny /) 
     171               iom_file(kiomid)%ofs(       ishft + jv) = 0. 
    156172            END DO 
    157173            ! 3d variable 
     174            ishft = in0d + in1d + in2d  
    158175            DO jv = 1, in3d 
    159                iom_file(kiomid)%cn_var(    in0d + in2d + jv) = TRIM(clna3d(jv)) 
    160                iom_file(kiomid)%nvid(      in0d + in2d + jv) = zval3d(jv) 
    161                iom_file(kiomid)%ndims(     in0d + in2d + jv) = 3 
    162                iom_file(kiomid)%dimsz(1:3, in0d + in2d + jv) = (/ inx, iny, jpk /) 
    163                iom_file(kiomid)%ofs(       in0d + in2d + jv) = 0. 
     176               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna3d(jv)) 
     177               iom_file(kiomid)%nvid(      ishft + jv) = zval3d(jv) 
     178               iom_file(kiomid)%ndims(     ishft + jv) = 3 
     179               iom_file(kiomid)%dimsz(1:3, ishft + jv) = (/ inx, iny, jpk /) 
     180               iom_file(kiomid)%ofs(       ishft + jv) = 0. 
    164181            END DO 
    165182         ELSE                 ! new file 
    … …  
    171188      ENDIF 
    172189987   CONTINUE 
    173       IF( ios /= 0 )   CALL ctl_stop( TRIM(clinfo), 'error in opening file '//TRIM(cdname) ) 
     190      IF( ios /= 0 ) THEN 
     191         WRITE(ctmp1,*) '           iostat = ', ios 
     192         CALL ctl_stop( TRIM(clinfo), '   error in opening file '//TRIM(cdname), ctmp1 ) 
     193      ENDIF 
    174194      ! 
    175195   END SUBROUTINE iom_rstdimg_open 
    … …  
    191211      INTEGER                                 ::   idrst                      ! file logical unit 
    192212      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable 
    193       INTEGER                                 ::   in0d, in2d, in3d           ! number of 0/2/3D variables 
    194       CHARACTER(LEN=8), DIMENSION(jpmax_vars) ::   clna0d, clna2d, clna3d     ! name of 0/2/3D variables 
    195       REAL(wp),         DIMENSION(jpmax_vars) ::   zval0d, zval2d, zval3d     ! value of 0d variables or 
    196       !                                                                       ! record position for 2/3D variables 
     213      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables 
     214      CHARACTER(LEN=8), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables 
     215      REAL(wp),         DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record 
     216      !                                                                               ! position for 1/2/3D variables 
    197217      !--------------------------------------------------------------------- 
    198218      ! 
    … …  
    206226         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   ! get back domain size 
    207227         ivnum = iom_file(kiomid)%nvars 
    208          in0d = 0   ;   in2d = 0   ;   in3d = 0 
     228         in0d = 0   ;   in1d = 0   ;   in2d = 0   ;   in3d = 0 
    209229         DO jv = 1, ivnum   ! loop on each variable to get its name and value/record position 
    210230            SELECT CASE (iom_file(kiomid)%ndims(jv)) 
    … …  
    213233               clna0d(in0d) = TRIM(iom_file(kiomid)%cn_var(jv)) 
    214234               zval0d(in0d) = iom_file(kiomid)%ofs(jv)   ! warning: trick... we use ofs to store the value 
     235            CASE (1)   ! 1d variable 
     236               in1d = in1d + 1 
     237               clna1d(in1d) = TRIM(iom_file(kiomid)%cn_var(jv)) 
     238               zval1d(in1d) = iom_file(kiomid)%nvid(jv) 
    215239            CASE (2)   ! 2d variable 
    216240               in2d = in2d + 1 
    … …  
    221245               clna3d(in3d) = TRIM(iom_file(kiomid)%cn_var(jv)) 
    222246               zval3d(in3d) = iom_file(kiomid)%nvid(jv) 
     247            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo), 'Should not ne there...' ) 
    223248            END SELECT 
    224249         END DO 
    225          ! update teh file header before closing it 
    226          WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in2d, in3d,   & 
    227                &   clna0d(1:in0d), zval0d(1:in0d), clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
    228                &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo,   & 
    229                &   nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt 
     250         ! force to have at least 1 valriable in each list (not necessary (?), but safer) 
     251         IF( in0d == 0 ) THEN   ;   in0d = 1   ;   clna0d(1) = 'no0d'   ;   zval0d(1) = -1.   ;   ENDIF 
     252         IF( in1d == 0 ) THEN   ;   in1d = 1   ;   clna1d(1) = 'no1d'   ;   zval1d(1) = -1.   ;   ENDIF 
     253         IF( in2d == 0 ) THEN   ;   in2d = 1   ;   clna2d(1) = 'no2d'   ;   zval2d(1) = -1.   ;   ENDIF 
     254         IF( in3d == 0 ) THEN   ;   in3d = 1   ;   clna3d(1) = 'no3d'   ;   zval3d(1) = -1.   ;   ENDIF 
     255         ! update the file header before closing it 
     256         WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d,   & 
     257            &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
     258            &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
     259            &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo, nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt 
    230260      ELSE 
    231261         ios = 0   ! we cannot write in the file 
    … …  
    234264      CLOSE( idrst, IOSTAT = ios, ERR = 987 ) 
    235265987   CONTINUE 
    236       IF( ios /= 0 )   CALL ctl_stop( TRIM(clinfo), 'error when updating the header of '//TRIM(iom_file(kiomid)%name) ) 
     266      IF( ios /= 0 ) THEN 
     267         WRITE(ctmp1,*) '           iostat = ', ios 
     268         CALL ctl_stop( TRIM(clinfo),   & 
     269            &   '   error when updating the header of '//TRIM(iom_file(kiomid)%name), ctmp1 ) 
     270      ENDIF 
    237271      !     
    238272   END SUBROUTINE iom_rstdimg_close 
    239273 
    240274 
    241    SUBROUTINE iom_rstdimg_get_0d( kiomid, kvid, pvar ) 
     275   SUBROUTINE iom_rstdimg_g0d( kiomid, kvid, pvar ) 
    242276      !!----------------------------------------------------------------------- 
    243       !!                  ***  ROUTINE  iom_rstdimg_get_0d  *** 
     277      !!                  ***  ROUTINE  iom_rstdimg_g0d  *** 
    244278      !! 
    245279      !! ** Purpose : read a scalar with RSTDIMG 
    … …  
    252286      pvar = iom_file(kiomid)%ofs(kvid)   ! warning: trick... we use ofs to store the value 
    253287      ! 
    254    END SUBROUTINE iom_rstdimg_get_0d 
    255  
    256  
    257    SUBROUTINE iom_rstdimg_rstput_0d( kiomid, cdvar, pv_r0d ) 
     288   END SUBROUTINE iom_rstdimg_g0d 
     289 
     290 
     291   SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, pv_r0d ) 
    258292      !!-------------------------------------------------------------------- 
    259293      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  *** 
    … …  
    269303      !--------------------------------------------------------------------- 
    270304      !   
    271       clinfo = '                    iom_rstdimg_rstput_0d ~~~  ' 
     305      clinfo = '                    iom_rstdimg_rp0d ~~~  ' 
    272306      idvar = iom_file(kiomid)%nvars + 1 
    273307      IF( idvar <= jpmax_vars ) THEN 
    … …  
    282316         CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' ) 
    283317      ENDIF 
    284    END SUBROUTINE iom_rstdimg_rstput_0d 
    285  
    286  
    287    SUBROUTINE iom_rstdimg_get_123d( kiomid, kdom  , kvid  , kstart, kcount,    & 
    288          &                           pv_r1d, pv_r2d, pv_r3d ) 
     318   END SUBROUTINE iom_rstdimg_rp0d 
     319 
     320 
     321   SUBROUTINE iom_rstdimg_g123d( kiomid, kdom  , kvid  , kstart, kcount,    & 
     322         &                          pv_r1d, pv_r2d, pv_r3d ) 
    289323      !!----------------------------------------------------------------------- 
    290       !!                  ***  ROUTINE  iom_rstdimg_get_123d  *** 
     324      !!                  ***  ROUTINE  iom_rstdimg_g123d  *** 
    291325      !! 
    292326      !! ** Purpose : read a 1D/2D/3D variable with RSTDIMG 
    … …  
    310344      INTEGER            ::   ix1, ix2, iy1, iy2   ! subdomain indexes 
    311345      !--------------------------------------------------------------------- 
    312       clinfo = '                    iom_rstdimg_get_123d ~~~  ' 
     346      clinfo = '                    iom_rstdimg_g123d ~~~  ' 
    313347      ! 
    314348      istop = nstop                   ! store the actual value of nstop 
    … …  
    341375            DO jk = 1, iom_file(kiomid)%dimsz(3,kvid)   ! do loop on each level 
    342376               READ( idrst, REC = iom_file(kiomid)%nvid(kvid) + jk - 1, IOSTAT = ios, ERR = 987 )   & 
    343                      &       pv_r3d( ix1:ix2, iy1:iy2, jk ) 
     377                     &      pv_r3d( ix1:ix2, iy1:iy2, jk ) 
    344378            END DO 
    345379            SELECT CASE (kdom) 
    … …  
    360394      ENDIF 
    361395987   CONTINUE 
    362       IF( ios /= 0 )   CALL ctl_stop( TRIM(clinfo) ) 
    363       ! 
    364    END SUBROUTINE iom_rstdimg_get_123d 
    365  
    366  
    367    SUBROUTINE iom_rstdimg_rstput_123d( kiomid, cdvar, pv_r1d, pv_r2d, pv_r3d ) 
     396      IF( ios /= 0 ) THEN 
     397         WRITE(ctmp1,*) '           iostat = ', ios 
     398         CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 ) 
     399      ENDIF 
     400      ! 
     401   END SUBROUTINE iom_rstdimg_g123d 
     402 
     403 
     404   SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, pv_r1d, pv_r2d, pv_r3d ) 
    368405      !!-------------------------------------------------------------------- 
    369406      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  *** 
    … …  
    389426      !--------------------------------------------------------------------- 
    390427      ! 
    391       clinfo = '          iom_rstdimg_rstput_123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar) 
     428      clinfo = '          iom_rstdimg_rp123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar) 
    392429      istop = nstop                   ! store the actual value of nstop 
    393430      irec = iom_file(kiomid)%irec    ! get back the record number of the variable 
    … …  
    424461            iom_file(kiomid)%irec              = irec + 1 
    425462            iom_file(kiomid)%ndims(     idvar) = 1 
    426             iom_file(kiomid)%dimsz(1:2, idvar) = inz 
     463            iom_file(kiomid)%dimsz(1  , idvar) = inz 
    427464         ELSEIF( PRESENT(pv_r2d) ) THEN 
    428465            iom_file(kiomid)%irec              = irec + 1 
    … …  
    441478      ENDIF 
    442479987   CONTINUE 
    443       IF( ios /= 0 ) THEN   ;   CALL ctl_stop( TRIM(clinfo) ) 
    444       ELSE                  ;   IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok' 
     480      IF( ios /= 0 ) THEN 
     481         WRITE(ctmp1,*) '           iostat = ', ios 
     482         CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 ) 
     483      ELSE 
     484         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok' 
    445485      ENDIF 
    446486      !      
    447    END SUBROUTINE iom_rstdimg_rstput_123d 
     487   END SUBROUTINE iom_rstdimg_rp123d 
    448488 
    449489 
Note: See TracChangeset for help on using the changeset viewer.