- Timestamp:
- 2019-12-10T12:57:49+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/IOM/iom.F90
r11521 r12143 58 58 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 59 59 PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 60 PUBLIC iom_use, iom_context_finalize 60 PUBLIC iom_use, iom_context_finalize, iom_miss_val 61 61 62 62 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 212 212 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 213 213 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 214 !215 # if defined key_floats216 214 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 217 # endif218 215 # if defined key_si3 219 216 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) … … 686 683 clname = trim(cdname) 687 684 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 688 iln = INDEX(clname,'/') 685 !FUS iln = INDEX(clname,'/') 686 iln = INDEX(clname,'/',BACK=.true.) ! FUS: to insert the nest index at the right location within the string, the last / has to be found (search from the right to left) 689 687 cltmpn = clname(1:iln) 690 688 clname = clname(iln+1:LEN_TRIM(clname)) … … 824 822 825 823 826 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ld stop )824 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop ) 827 825 !!----------------------------------------------------------------------- 828 826 !! *** FUNCTION iom_varid *** … … 833 831 CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable 834 832 INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of each dimension 835 INTEGER, INTENT( out), OPTIONAL :: kndims ! size of the dimensions 833 INTEGER , INTENT( out), OPTIONAL :: kndims ! number of dimensions 834 LOGICAL , INTENT( out), OPTIONAL :: lduld ! true if the last dimension is unlimited (time) 836 835 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.) 837 836 ! … … 863 862 iiv = iiv + 1 864 863 IF( iiv <= jpmax_vars ) THEN 865 iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims )864 iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld ) 866 865 ELSE 867 866 CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name, & … … 881 880 ENDIF 882 881 IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(iiv) 882 IF( PRESENT( lduld) ) lduld = iom_file(kiomid)%luld( iiv) 883 883 ENDIF 884 884 ENDIF … … 1259 1259 !--- overlap areas and extra hallows (mpp) 1260 1260 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1261 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.,'no0')1261 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 1262 1262 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1263 1263 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1264 1264 IF( icnt(3) == inlev ) THEN 1265 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.,'no0')1265 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 1266 1266 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1267 1267 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO … … 1288 1288 CALL xios_recv_field( trim(cdvar), pv_r3d) 1289 1289 IF(idom /= jpdom_unknown ) then 1290 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.,'no0')1290 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1291 1291 ENDIF 1292 1292 ELSEIF( PRESENT(pv_r2d) ) THEN … … 1295 1295 CALL xios_recv_field( trim(cdvar), pv_r2d) 1296 1296 IF(idom /= jpdom_unknown ) THEN 1297 CALL lbc_lnk('iom', pv_r2d,'Z',-999., 'no0')1297 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1298 1298 ENDIF 1299 1299 ELSEIF( PRESENT(pv_r1d) ) THEN … … 1658 1658 CHARACTER(LEN=*), INTENT(in) :: cdname 1659 1659 REAL(wp) , INTENT(in) :: pfield0d 1660 REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson1660 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1661 1661 #if defined key_iomput 1662 zz(:,:)=pfield0d1663 CALL xios_send_field(cdname, zz)1664 !CALL xios_send_field(cdname, (/pfield0d/))1662 !!clem zz(:,:)=pfield0d 1663 !!clem CALL xios_send_field(cdname, zz) 1664 CALL xios_send_field(cdname, (/pfield0d/)) 1665 1665 #else 1666 1666 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 1968 1968 ! Cell vertices on boundries 1969 1969 DO jn = 1, 4 1970 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., p val=999._wp )1971 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., p val=999._wp )1970 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 1971 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 1972 1972 END DO 1973 1973 ! … … 2228 2228 CHARACTER(LEN=20) :: clfreq 2229 2229 CHARACTER(LEN=20) :: cldate 2230 CHARACTER(LEN=256) :: cltmpn !FUS needed for correct path with AGRIF 2231 INTEGER :: iln !FUS needed for correct path with AGRIF 2230 2232 INTEGER :: idx 2231 2233 INTEGER :: jn … … 2310 2312 END DO 2311 2313 ! 2312 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 2314 !FUS IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 2315 !FUS see comment line 700 2316 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN 2317 iln = INDEX(clname,'/',BACK=.true.) 2318 cltmpn = clname(1:iln) 2319 clname = clname(iln+1:LEN_TRIM(clname)) 2320 clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 2321 ENDIF 2322 !FUS 2313 2323 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 2314 2324 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 2378 2388 !! NOT 'key_iomput' a few dummy routines 2379 2389 !!---------------------------------------------------------------------- 2380 2381 2390 SUBROUTINE iom_setkt( kt, cdname ) 2382 2391 INTEGER , INTENT(in):: kt … … 2393 2402 2394 2403 LOGICAL FUNCTION iom_use( cdname ) 2395 !!----------------------------------------------------------------------2396 !!----------------------------------------------------------------------2397 2404 CHARACTER(LEN=*), INTENT(in) :: cdname 2398 !!----------------------------------------------------------------------2399 2405 #if defined key_iomput 2400 2406 iom_use = xios_field_is_active( cdname ) … … 2403 2409 #endif 2404 2410 END FUNCTION iom_use 2405 2411 2412 SUBROUTINE iom_miss_val( cdname, pmiss_val ) 2413 CHARACTER(LEN=*), INTENT(in ) :: cdname 2414 REAL(wp) , INTENT(out) :: pmiss_val 2415 #if defined key_iomput 2416 ! get missing value 2417 CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 2418 #else 2419 IF( .FALSE. ) WRITE(numout,*) cdname, pmiss_val ! useless test to avoid compilation warnings 2420 #endif 2421 END SUBROUTINE iom_miss_val 2422 2406 2423 !!====================================================================== 2407 2424 END MODULE iom
Note: See TracChangeset
for help on using the changeset viewer.