- Timestamp:
- 2019-12-05T12:06:36+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/IOM/iom.F90
r10523 r12065 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) /) ) … … 222 219 # endif 223 220 #if defined key_top 224 CALL iom_set_axis_attr( "profsed", paxis = profsed )221 IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed ) 225 222 #endif 226 223 CALL iom_set_axis_attr( "icbcla", class_num ) 227 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 228 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 224 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea... 225 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 229 226 ENDIF 230 227 ! … … 697 694 clname = trim(cdname) 698 695 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 699 iln = INDEX(clname,'/') 696 !FUS iln = INDEX(clname,'/') 697 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) 700 698 cltmpn = clname(1:iln) 701 699 clname = clname(iln+1:LEN_TRIM(clname)) … … 835 833 836 834 837 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ld stop )835 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop ) 838 836 !!----------------------------------------------------------------------- 839 837 !! *** FUNCTION iom_varid *** … … 844 842 CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable 845 843 INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of each dimension 846 INTEGER, INTENT( out), OPTIONAL :: kndims ! size of the dimensions 844 INTEGER , INTENT( out), OPTIONAL :: kndims ! number of dimensions 845 LOGICAL , INTENT( out), OPTIONAL :: lduld ! true if the last dimension is unlimited (time) 847 846 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.) 848 847 ! … … 874 873 iiv = iiv + 1 875 874 IF( iiv <= jpmax_vars ) THEN 876 iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims )875 iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld ) 877 876 ELSE 878 877 CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name, & … … 892 891 ENDIF 893 892 IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(iiv) 893 IF( PRESENT( lduld) ) lduld = iom_file(kiomid)%luld( iiv) 894 894 ENDIF 895 895 ENDIF … … 1270 1270 !--- overlap areas and extra hallows (mpp) 1271 1271 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1272 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.,'no0')1272 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 1273 1273 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1274 1274 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1275 1275 IF( icnt(3) == inlev ) THEN 1276 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.,'no0')1276 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 1277 1277 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1278 1278 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO … … 1299 1299 CALL xios_recv_field( trim(cdvar), pv_r3d) 1300 1300 IF(idom /= jpdom_unknown ) then 1301 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.,'no0')1301 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1302 1302 ENDIF 1303 1303 ELSEIF( PRESENT(pv_r2d) ) THEN … … 1306 1306 CALL xios_recv_field( trim(cdvar), pv_r2d) 1307 1307 IF(idom /= jpdom_unknown ) THEN 1308 CALL lbc_lnk('iom', pv_r2d,'Z',-999., 'no0')1308 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1309 1309 ENDIF 1310 1310 ELSEIF( PRESENT(pv_r1d) ) THEN … … 1669 1669 CHARACTER(LEN=*), INTENT(in) :: cdname 1670 1670 REAL(wp) , INTENT(in) :: pfield0d 1671 REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson1671 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1672 1672 #if defined key_iomput 1673 zz(:,:)=pfield0d1674 CALL xios_send_field(cdname, zz)1675 !CALL xios_send_field(cdname, (/pfield0d/))1673 !!clem zz(:,:)=pfield0d 1674 !!clem CALL xios_send_field(cdname, zz) 1675 CALL xios_send_field(cdname, (/pfield0d/)) 1676 1676 #else 1677 1677 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 1979 1979 ! Cell vertices on boundries 1980 1980 DO jn = 1, 4 1981 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., p val=999._wp )1982 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., p val=999._wp )1981 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 1982 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 1983 1983 END DO 1984 1984 ! … … 2239 2239 CHARACTER(LEN=20) :: clfreq 2240 2240 CHARACTER(LEN=20) :: cldate 2241 CHARACTER(LEN=256) :: cltmpn !FUS needed for correct path with AGRIF 2242 INTEGER :: iln !FUS needed for correct path with AGRIF 2241 2243 INTEGER :: idx 2242 2244 INTEGER :: jn … … 2321 2323 END DO 2322 2324 ! 2323 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 2325 !FUS IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 2326 !FUS see comment line 700 2327 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) THEN 2328 iln = INDEX(clname,'/',BACK=.true.) 2329 cltmpn = clname(1:iln) 2330 clname = clname(iln+1:LEN_TRIM(clname)) 2331 clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 2332 ENDIF 2333 !FUS 2324 2334 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 2325 2335 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 2389 2399 !! NOT 'key_iomput' a few dummy routines 2390 2400 !!---------------------------------------------------------------------- 2391 2392 2401 SUBROUTINE iom_setkt( kt, cdname ) 2393 2402 INTEGER , INTENT(in):: kt … … 2404 2413 2405 2414 LOGICAL FUNCTION iom_use( cdname ) 2406 !!----------------------------------------------------------------------2407 !!----------------------------------------------------------------------2408 2415 CHARACTER(LEN=*), INTENT(in) :: cdname 2409 !!----------------------------------------------------------------------2410 2416 #if defined key_iomput 2411 2417 iom_use = xios_field_is_active( cdname ) … … 2414 2420 #endif 2415 2421 END FUNCTION iom_use 2416 2422 2423 SUBROUTINE iom_miss_val( cdname, pmiss_val ) 2424 CHARACTER(LEN=*), INTENT(in ) :: cdname 2425 REAL(wp) , INTENT(out) :: pmiss_val 2426 #if defined key_iomput 2427 ! get missing value 2428 CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 2429 #else 2430 IF( .FALSE. ) WRITE(numout,*) cdname, pmiss_val ! useless test to avoid compilation warnings 2431 #endif 2432 END SUBROUTINE iom_miss_val 2433 2417 2434 !!====================================================================== 2418 2435 END MODULE iom
Note: See TracChangeset
for help on using the changeset viewer.