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 588 for trunk/NEMO/OPA_SRC – NEMO

Changeset 588 for trunk/NEMO/OPA_SRC


Ignore:
Timestamp:
2007-01-04T10:45:24+01:00 (17 years ago)
Author:
opalod
Message:

nemo_v2_bugfix_001 : SM + CT : - add an initialization of iom_file(kiomid)%luld(kiv) field

  • change "offset" to "add_offset" characters
  • use a loop instead of the MINLOC function to find the minimum value of an array
  • allow to write/read headers of DIMG files over 2 records (iom_rstdimg.F90)
Location:
trunk/NEMO/OPA_SRC/IOM
Files:
3 edited

Legend:

Unmodified
Added
Removed

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

    r559 r588  
    5959      INTEGER            ::   ifliodom   ! model domain identifier (see flio_dom_set) 
    6060      INTEGER            ::   ioipslid   ! ioipsl identifier of the opened file 
     61      INTEGER            ::   jl         ! loop variable 
    6162      !--------------------------------------------------------------------- 
    6263 
    … …  
    9899      ! ============= 
    99100      IF( istop == nstop ) THEN   ! no error within this routine 
    100          kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     101!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     102         kiomid = 0 
     103         DO jl = jpmax_files, 1, -1 
     104            IF( iom_file(jl)%nfid == 0 )   kiomid = jl 
     105         ENDDO 
    101106         iom_file(kiomid)%name   = TRIM(cdname) 
    102107         iom_file(kiomid)%nfid   = ioipslid 
    … …  
    161166                  &           len_dims = iom_file(kiomid)%dimsz(1:i_nvd,kiv), &   ! dimensions size 
    162167                  &           id_dims  = idimid(1:i_nvd) )                        ! dimensions ids 
    163             DO ji = 1, i_nvd   ! find the unlimited dimension 
     168            iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
     169            DO ji = 1, i_nvd                       ! find the unlimited dimension 
    164170               IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE. 
    165171            END DO 
    166             !---------- Deal with scale_factor and offset 
     172            !---------- Deal with scale_factor and add_offset 
    167173            CALL flioinqa( ioipslid, cdvar, 'scale_factor', ll_fnd ) 
    168174            IF( ll_fnd) THEN 
    … …  
    171177               iom_file(kiomid)%scf(kiv) = 1. 
    172178            END IF 
    173             CALL flioinqa( ioipslid, cdvar, 'offset', ll_fnd ) 
     179            CALL flioinqa( ioipslid, cdvar, 'add_offset', ll_fnd ) 
    174180            IF( ll_fnd ) THEN 
    175                CALL fliogeta( ioipslid, cdvar, 'offset', iom_file(kiomid)%ofs(kiv) ) 
     181               CALL fliogeta( ioipslid, cdvar, 'add_offset', iom_file(kiomid)%ofs(kiv) ) 
    176182            ELSE 
    177183               iom_file(kiomid)%ofs(kiv) = 0. 

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

    r559 r588  
    6060      INTEGER            ::   if90id   ! nf90 identifier of the opened file 
    6161      INTEGER            ::   idmy     ! dummy variable 
     62      INTEGER            ::   jl       ! loop variable 
    6263      !--------------------------------------------------------------------- 
    6364 
    … …  
    109110      ! ============= 
    110111      IF( istop == nstop ) THEN   ! no error within this routine 
    111          kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     112!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     113         kiomid = 0 
     114         DO jl = jpmax_files, 1, -1 
     115            IF( iom_file(jl)%nfid == 0 )   kiomid = jl 
     116         ENDDO 
    112117         iom_file(kiomid)%name   = TRIM(cdname) 
    113118         iom_file(kiomid)%nfid   = if90id 
    … …  
    174179         iom_file(kiomid)%ndims(kiv)  = i_nvd 
    175180         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids 
    176          DO ji = 1, i_nvd   ! dimensions size 
     181         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
     182         DO ji = 1, i_nvd                       ! dimensions size 
    177183            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    
    178184            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension?  
    179185         END DO 
    180          !---------- Deal with scale_factor and offset 
     186         !---------- Deal with scale_factor and add_offset 
    181187         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr 
    182188         IF( llok) THEN 
    … …  
    185191            iom_file(kiomid)%scf(kiv) = 1. 
    186192         END IF 
    187          llok = NF90_Inquire_attribute(if90id, ivarid, 'offset') == nf90_noerr 
     193         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr 
    188194         IF( llok ) THEN 
    189             CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'offset', iom_file(kiomid)%ofs(kiv)), clinfo) 
     195            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo) 
    190196         ELSE 
    191197            iom_file(kiomid)%ofs(kiv) = 0. 

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

    r584 r588  
    3131      MODULE PROCEDURE iom_rstdimg_rp0d, iom_rstdimg_rp123d 
    3232   END INTERFACE 
     33 
     34   INTEGER, PARAMETER ::   jpvnl          = 32   ! variable name length 
     35       
    3336   !!---------------------------------------------------------------------- 
    3437   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    … …  
    5962      INTEGER                                 ::   irecl8                     ! record length 
    6063      INTEGER                                 ::   ios                        ! IO status 
     64      INTEGER                                 ::   irhd                       ! record of the header infos 
    6165      INTEGER                                 ::   ivnum                      ! number of variables 
    6266      INTEGER                                 ::   ishft                      ! counter shift 
    … …  
    6468      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables 
    6569      INTEGER                                 ::   ipni, ipnj, ipnij, iarea   ! domain decomposition  
    66       CHARACTER(LEN=32), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables 
     70      INTEGER                                 ::   jl                         ! loop variable 
     71      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables 
    6772      REAL(wp),         DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record 
    6873      !                                                                               ! position for 1/2/3D variables 
    6974      !--------------------------------------------------------------------- 
    70  
    7175      clinfo = '                    iom_rstdimg_open ~~~  ' 
    7276      istop = nstop      ! store the actual value of nstop 
    … …  
    99103         iln = INDEX( cdname, '.dimg' ) 
    100104         IF( ldwrt ) THEN  ! the file should be open in readwrite mode so we create it... 
    101             irecl8= kdompar(1,1) * kdompar(2,1) * wp 
     105            irecl8= MAX( kdompar(1,1) * kdompar(2,1) * wp, ( 8*jpnij + 15 ) * 4 ) 
    102106            IF( jpnij > 1 ) THEN 
    103107               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.dimg' 
    … …  
    114118      ! ============= 
    115119      IF( ldok ) THEN      ! old file 
    116          READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d 
    117          READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d,   & 
     120         READ( idrst, REC = 1   , IOSTAT = ios, ERR = 987 )   & 
     121              &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd 
     122         READ( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )   & 
    118123            &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
    119124            &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
    … …  
    131136      ! ============= 
    132137      IF( istop == nstop ) THEN   ! no error within this routine 
    133          kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     138!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     139         kiomid = 0 
     140         DO jl = jpmax_files, 1, -1 
     141            IF( iom_file(jl)%nfid == 0 )   kiomid = jl 
     142         ENDDO 
    134143         iom_file(kiomid)%name    = TRIM(cdname) 
    135144         iom_file(kiomid)%nfid    = idrst 
    … …  
    209218      INTEGER                                 ::   irecl8                     ! record length 
    210219      INTEGER                                 ::   ios                        ! IO status 
     220      INTEGER                                 ::   irhd                       ! record of the header infos 
    211221      INTEGER                                 ::   ivnum                      ! number of variables 
    212222      INTEGER                                 ::   idrst                      ! file logical unit 
    213223      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable 
    214224      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables 
    215       CHARACTER(LEN=32), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d    ! name of 0/1/2/3D variables 
     225      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d    ! name of 0/1/2/3D variables 
    216226      REAL(wp),          DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d    ! value of 0d variables or record 
    217227      !                                                                               ! position for 1/2/3D variables 
    … …  
    226236      IF( ios == 0 ) THEN 
    227237         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   ! get back domain size 
     238         irhd = iom_file(kiomid)%irec 
    228239         ivnum = iom_file(kiomid)%nvars 
    229240         in0d = 0   ;   in1d = 0   ;   in2d = 0   ;   in3d = 0 
    … …  
    249260            END SELECT 
    250261         END DO 
    251          ! force to have at least 1 valriable in each list (not necessary (?), but safer) 
     262         ! force to have at least 1 variable in each list (not necessary (?), but safer...) 
    252263         IF( in0d == 0 ) THEN   ;   in0d = 1   ;   clna0d(1) = 'no0d'   ;   zval0d(1) = -1.   ;   ENDIF 
    253264         IF( in1d == 0 ) THEN   ;   in1d = 1   ;   clna1d(1) = 'no1d'   ;   zval1d(1) = -1.   ;   ENDIF 
    … …  
    255266         IF( in3d == 0 ) THEN   ;   in3d = 1   ;   clna3d(1) = 'no3d'   ;   zval3d(1) = -1.   ;   ENDIF 
    256267         ! update the file header before closing it 
    257          WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d,   & 
    258             &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
    259             &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
    260             &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo, nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt 
     268         WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 )   & 
     269            &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   & 
     270            &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo,   & 
     271            &   nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt 
     272         IF( (ivnum * (jpvnl + wp)) > irecl8 ) THEN  
     273            CALL ctl_stop( TRIM(clinfo),   & 
     274                 &   'Last record size is too big... You could reduce the value of jpvnl' ) 
     275         ELSE  
     276            WRITE( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )    & 
     277                 &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
     278                 &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d) 
     279         ENDIF 
    261280      ELSE 
    262281         ios = 0   ! we cannot write in the file 
Note: See TracChangeset for help on using the changeset viewer.