- Timestamp:
- 2020-07-07T12:23:18+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12973_AGRIF_CMEMS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/iom.F90 (modified) (41 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS
- Property svn:externals
-
old new 2 2 ^/utils/build/makenemo@HEAD makenemo 3 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools _dev_r12970_AGRIF_CMEMStools4 ^/utils/tools/@HEAD tools 5 5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/IOM/iom.F90
r12649 r13258 59 59 PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 60 60 61 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 62 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 63 PRIVATE iom_p1d, iom_p2d, iom_p3d, iom_p4d 61 PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 62 PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 63 PRIVATE iom_get_123d 64 PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 65 PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 66 PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 67 PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 64 68 #if defined key_iomput 65 69 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr … … 70 74 71 75 INTERFACE iom_get 72 MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d 76 MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 77 MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 73 78 END INTERFACE 74 79 INTERFACE iom_getatt … … 79 84 END INTERFACE 80 85 INTERFACE iom_rstput 81 MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 86 MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 87 MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 82 88 END INTERFACE 83 89 INTERFACE iom_put 84 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d, iom_p4d 90 MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 91 MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 85 92 END INTERFACE iom_put 86 93 … … 169 176 ! 170 177 IF( ln_cfmeta ) THEN ! Add additional grid metadata 171 CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))172 CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))173 CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))174 CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))178 CALL iom_set_domain_attr("grid_T", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 179 CALL iom_set_domain_attr("grid_U", area = real( e1e2u(nldi:nlei, nldj:nlej), dp)) 180 CALL iom_set_domain_attr("grid_V", area = real( e1e2v(nldi:nlei, nldj:nlej), dp)) 181 CALL iom_set_domain_attr("grid_W", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 175 182 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 176 183 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) … … 192 199 ! 193 200 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 194 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))195 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))196 CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))197 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))201 CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp)) 202 CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej), dp) ) 203 CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej), dp) ) 204 CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp ) ) 198 205 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 199 206 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) … … 941 948 !! INTERFACE iom_get 942 949 !!---------------------------------------------------------------------- 943 SUBROUTINE iom_g0d ( kiomid, cdvar, pvar, ktime, ldxios )950 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime, ldxios ) 944 951 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 945 952 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 946 REAL(wp) , INTENT( out) :: pvar ! read field 953 REAL(sp) , INTENT( out) :: pvar ! read field 954 REAL(dp) :: ztmp_pvar ! tmp var to read field 955 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 956 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart 957 ! 958 INTEGER :: idvar ! variable id 959 INTEGER :: idmspc ! number of spatial dimensions 960 INTEGER , DIMENSION(1) :: itime ! record number 961 CHARACTER(LEN=100) :: clinfo ! info character 962 CHARACTER(LEN=100) :: clname ! file name 963 CHARACTER(LEN=1) :: cldmspc ! 964 LOGICAL :: llxios 965 ! 966 llxios = .FALSE. 967 IF( PRESENT(ldxios) ) llxios = ldxios 968 969 IF(.NOT.llxios) THEN ! read data using default library 970 itime = 1 971 IF( PRESENT(ktime) ) itime = ktime 972 ! 973 clname = iom_file(kiomid)%name 974 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 975 ! 976 IF( kiomid > 0 ) THEN 977 idvar = iom_varid( kiomid, cdvar ) 978 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 979 idmspc = iom_file ( kiomid )%ndims( idvar ) 980 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 981 WRITE(cldmspc , fmt='(i1)') idmspc 982 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 983 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 984 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 985 CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime ) 986 pvar = ztmp_pvar 987 ENDIF 988 ENDIF 989 ELSE 990 #if defined key_iomput 991 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 992 CALL iom_swap( TRIM(crxios_context) ) 993 CALL xios_recv_field( trim(cdvar), pvar) 994 CALL iom_swap( TRIM(cxios_context) ) 995 #else 996 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 997 CALL ctl_stop( 'iom_g0d', ctmp1 ) 998 #endif 999 ENDIF 1000 END SUBROUTINE iom_g0d_sp 1001 1002 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime, ldxios ) 1003 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1004 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1005 REAL(dp) , INTENT( out) :: pvar ! read field 947 1006 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 948 1007 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart … … 989 1048 #endif 990 1049 ENDIF 991 END SUBROUTINE iom_g0d 992 993 SUBROUTINE iom_g1d ( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios )1050 END SUBROUTINE iom_g0d_dp 1051 1052 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 994 1053 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 995 1054 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 996 1055 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 997 REAL(wp) , INTENT( out), DIMENSION(:) :: pvar ! read field 1056 REAL(sp) , INTENT( out), DIMENSION(:) :: pvar ! read field 1057 REAL(dp) , ALLOCATABLE , DIMENSION(:) :: ztmp_pvar ! tmp var to read field 998 1058 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 999 1059 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading … … 1002 1062 ! 1003 1063 IF( kiomid > 0 ) THEN 1064 IF( iom_file(kiomid)%nfid > 0 ) THEN 1065 ALLOCATE(ztmp_pvar(size(pvar,1))) 1066 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1067 & ktime=ktime, kstart=kstart, kcount=kcount, & 1068 & ldxios=ldxios ) 1069 pvar = ztmp_pvar 1070 DEALLOCATE(ztmp_pvar) 1071 END IF 1072 ENDIF 1073 END SUBROUTINE iom_g1d_sp 1074 1075 1076 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 1077 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1078 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1079 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1080 REAL(dp) , INTENT( out), DIMENSION(:) :: pvar ! read field 1081 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1082 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1083 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1084 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1085 ! 1086 IF( kiomid > 0 ) THEN 1004 1087 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 1005 1088 & ktime=ktime, kstart=kstart, kcount=kcount, & 1006 1089 & ldxios=ldxios ) 1007 1090 ENDIF 1008 END SUBROUTINE iom_g1d 1009 1010 SUBROUTINE iom_g2d ( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios)1091 END SUBROUTINE iom_g1d_dp 1092 1093 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 1011 1094 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1012 1095 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1013 1096 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1014 REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1097 REAL(sp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1098 REAL(dp) , ALLOCATABLE , DIMENSION(:,:) :: ztmp_pvar ! tmp var to read field 1015 1099 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1016 1100 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading … … 1023 1107 ! 1024 1108 IF( kiomid > 0 ) THEN 1109 IF( iom_file(kiomid)%nfid > 0 ) THEN 1110 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 1111 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=ztmp_pvar, & 1112 & ktime=ktime, kstart=kstart, kcount=kcount, & 1113 & lrowattr=lrowattr, ldxios=ldxios) 1114 pvar = ztmp_pvar 1115 DEALLOCATE(ztmp_pvar) 1116 END IF 1117 ENDIF 1118 END SUBROUTINE iom_g2d_sp 1119 1120 1121 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 1122 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1123 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1124 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1125 REAL(dp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1126 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1127 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 1128 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 1129 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1130 ! look for and use a file attribute 1131 ! called open_ocean_jstart to set the start 1132 ! value for the 2nd dimension (netcdf only) 1133 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1134 ! 1135 IF( kiomid > 0 ) THEN 1025 1136 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 1026 1137 & ktime=ktime, kstart=kstart, kcount=kcount, & 1027 1138 & lrowattr=lrowattr, ldxios=ldxios) 1028 1139 ENDIF 1029 END SUBROUTINE iom_g2d 1030 1031 SUBROUTINE iom_g3d ( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios )1140 END SUBROUTINE iom_g2d_dp 1141 1142 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 1032 1143 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1033 1144 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1034 1145 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1035 REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1146 REAL(sp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1147 REAL(dp) , ALLOCATABLE , DIMENSION(:,:,:) :: ztmp_pvar ! tmp var to read field 1036 1148 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1037 1149 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading … … 1044 1156 ! 1045 1157 IF( kiomid > 0 ) THEN 1158 IF( iom_file(kiomid)%nfid > 0 ) THEN 1159 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 1160 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=ztmp_pvar, & 1161 & ktime=ktime, kstart=kstart, kcount=kcount, & 1162 & lrowattr=lrowattr, ldxios=ldxios ) 1163 pvar = ztmp_pvar 1164 DEALLOCATE(ztmp_pvar) 1165 END IF 1166 ENDIF 1167 END SUBROUTINE iom_g3d_sp 1168 1169 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 1170 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1171 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1172 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1173 REAL(dp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1174 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1175 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 1176 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 1177 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1178 ! look for and use a file attribute 1179 ! called open_ocean_jstart to set the start 1180 ! value for the 2nd dimension (netcdf only) 1181 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1182 ! 1183 IF( kiomid > 0 ) THEN 1046 1184 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 1047 1185 & ktime=ktime, kstart=kstart, kcount=kcount, & 1048 1186 & lrowattr=lrowattr, ldxios=ldxios ) 1049 1187 ENDIF 1050 END SUBROUTINE iom_g3d 1188 END SUBROUTINE iom_g3d_dp 1189 1190 1191 1051 1192 !!---------------------------------------------------------------------- 1052 1193 … … 1065 1206 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1066 1207 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 1067 REAL( wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case)1068 REAL( wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case)1069 REAL( wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case)1208 REAL(dp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1209 REAL(dp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1210 REAL(dp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1070 1211 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1071 1212 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis … … 1096 1237 INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable 1097 1238 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable 1098 REAL( wp) :: zscf, zofs ! sacle_factor and add_offset1239 REAL(dp) :: zscf, zofs ! sacle_factor and add_offset 1099 1240 INTEGER :: itmp ! temporary integer 1100 1241 CHARACTER(LEN=256) :: clinfo ! info character … … 1103 1244 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1104 1245 INTEGER :: inlev ! number of levels for 3D data 1105 REAL( wp) :: gma, gmi1246 REAL(dp) :: gma, gmi 1106 1247 !--------------------------------------------------------------------- 1107 1248 ! … … 1193 1334 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1194 1335 idmspc = idmspc - 1 1195 ELSE 1196 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 1197 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 1198 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1336 !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation 1337 !ELSE 1338 ! CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,', & 1339 ! & 'we do not accept data with '//cldmspc//' spatial dimensions' , & 1340 ! & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1199 1341 ENDIF 1200 1342 ENDIF … … 1311 1453 !--- overlap areas and extra hallows (mpp) 1312 1454 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1313 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999. , kfillmode = jpfillnothing )1455 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 1314 1456 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1315 1457 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1316 1458 IF( icnt(3) == inlev ) THEN 1317 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999. , kfillmode = jpfillnothing )1459 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 1318 1460 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1319 1461 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO … … 1340 1482 CALL xios_recv_field( trim(cdvar), pv_r3d) 1341 1483 IF(idom /= jpdom_unknown ) then 1342 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999. , kfillmode = jpfillnothing)1484 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing) 1343 1485 ENDIF 1344 1486 ELSEIF( PRESENT(pv_r2d) ) THEN … … 1347 1489 CALL xios_recv_field( trim(cdvar), pv_r2d) 1348 1490 IF(idom /= jpdom_unknown ) THEN 1349 CALL lbc_lnk('iom', pv_r2d,'Z',-999. , kfillmode = jpfillnothing)1491 CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing) 1350 1492 ENDIF 1351 1493 ELSEIF( PRESENT(pv_r1d) ) THEN … … 1362 1504 !some final adjustments 1363 1505 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1364 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( 'iom', pv_r2d,'Z',1. )1365 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( 'iom', pv_r3d,'Z',1. )1506 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 1507 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 1366 1508 1367 1509 !--- Apply scale_factor and offset … … 1550 1692 !! INTERFACE iom_rstput 1551 1693 !!---------------------------------------------------------------------- 1552 SUBROUTINE iom_rp0d ( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1694 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1553 1695 INTEGER , INTENT(in) :: kt ! ocean time-step 1554 1696 INTEGER , INTENT(in) :: kwrite ! writing time-step 1555 1697 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1556 1698 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1557 REAL( wp) , INTENT(in) :: pvar ! written field1699 REAL(sp) , INTENT(in) :: pvar ! written field 1558 1700 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1559 1701 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1574 1716 IF( iom_file(kiomid)%nfid > 0 ) THEN 1575 1717 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1576 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar)1718 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = real(pvar, dp) ) 1577 1719 ENDIF 1578 1720 ENDIF 1579 1721 ENDIF 1580 END SUBROUTINE iom_rp0d 1581 1582 SUBROUTINE iom_rp 1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1722 END SUBROUTINE iom_rp0d_sp 1723 1724 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1583 1725 INTEGER , INTENT(in) :: kt ! ocean time-step 1584 1726 INTEGER , INTENT(in) :: kwrite ! writing time-step 1585 1727 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1586 1728 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1587 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1729 REAL(dp) , INTENT(in) :: pvar ! written field 1730 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1731 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1732 LOGICAL :: llx ! local xios write flag 1733 INTEGER :: ivid ! variable id 1734 1735 llx = .FALSE. 1736 IF(PRESENT(ldxios)) llx = ldxios 1737 IF( llx ) THEN 1738 #ifdef key_iomput 1739 IF( kt == kwrite ) THEN 1740 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1741 CALL xios_send_field(trim(cdvar), pvar) 1742 ENDIF 1743 #endif 1744 ELSE 1745 IF( kiomid > 0 ) THEN 1746 IF( iom_file(kiomid)%nfid > 0 ) THEN 1747 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1748 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1749 ENDIF 1750 ENDIF 1751 ENDIF 1752 END SUBROUTINE iom_rp0d_dp 1753 1754 1755 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1756 INTEGER , INTENT(in) :: kt ! ocean time-step 1757 INTEGER , INTENT(in) :: kwrite ! writing time-step 1758 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1759 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1760 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1588 1761 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1589 1762 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1604 1777 IF( iom_file(kiomid)%nfid > 0 ) THEN 1605 1778 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1606 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar)1779 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = real(pvar, dp) ) 1607 1780 ENDIF 1608 1781 ENDIF 1609 1782 ENDIF 1610 END SUBROUTINE iom_rp1d 1611 1612 SUBROUTINE iom_rp 2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1783 END SUBROUTINE iom_rp1d_sp 1784 1785 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1613 1786 INTEGER , INTENT(in) :: kt ! ocean time-step 1614 1787 INTEGER , INTENT(in) :: kwrite ! writing time-step 1615 1788 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1616 1789 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1617 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1790 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1791 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1792 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1793 LOGICAL :: llx ! local xios write flag 1794 INTEGER :: ivid ! variable id 1795 1796 llx = .FALSE. 1797 IF(PRESENT(ldxios)) llx = ldxios 1798 IF( llx ) THEN 1799 #ifdef key_iomput 1800 IF( kt == kwrite ) THEN 1801 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1802 CALL xios_send_field(trim(cdvar), pvar) 1803 ENDIF 1804 #endif 1805 ELSE 1806 IF( kiomid > 0 ) THEN 1807 IF( iom_file(kiomid)%nfid > 0 ) THEN 1808 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1809 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1810 ENDIF 1811 ENDIF 1812 ENDIF 1813 END SUBROUTINE iom_rp1d_dp 1814 1815 1816 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1817 INTEGER , INTENT(in) :: kt ! ocean time-step 1818 INTEGER , INTENT(in) :: kwrite ! writing time-step 1819 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1820 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1821 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1618 1822 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1619 1823 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1634 1838 IF( iom_file(kiomid)%nfid > 0 ) THEN 1635 1839 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1636 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar)1840 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = real(pvar, dp) ) 1637 1841 ENDIF 1638 1842 ENDIF 1639 1843 ENDIF 1640 END SUBROUTINE iom_rp2d 1641 1642 SUBROUTINE iom_rp 3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1844 END SUBROUTINE iom_rp2d_sp 1845 1846 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1643 1847 INTEGER , INTENT(in) :: kt ! ocean time-step 1644 1848 INTEGER , INTENT(in) :: kwrite ! writing time-step 1645 1849 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1646 1850 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1647 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1851 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1852 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1853 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1854 LOGICAL :: llx 1855 INTEGER :: ivid ! variable id 1856 1857 llx = .FALSE. 1858 IF(PRESENT(ldxios)) llx = ldxios 1859 IF( llx ) THEN 1860 #ifdef key_iomput 1861 IF( kt == kwrite ) THEN 1862 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1863 CALL xios_send_field(trim(cdvar), pvar) 1864 ENDIF 1865 #endif 1866 ELSE 1867 IF( kiomid > 0 ) THEN 1868 IF( iom_file(kiomid)%nfid > 0 ) THEN 1869 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1870 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1871 ENDIF 1872 ENDIF 1873 ENDIF 1874 END SUBROUTINE iom_rp2d_dp 1875 1876 1877 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1878 INTEGER , INTENT(in) :: kt ! ocean time-step 1879 INTEGER , INTENT(in) :: kwrite ! writing time-step 1880 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1881 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1882 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1648 1883 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1649 1884 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1664 1899 IF( iom_file(kiomid)%nfid > 0 ) THEN 1665 1900 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1901 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = real(pvar, dp) ) 1902 ENDIF 1903 ENDIF 1904 ENDIF 1905 END SUBROUTINE iom_rp3d_sp 1906 1907 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1908 INTEGER , INTENT(in) :: kt ! ocean time-step 1909 INTEGER , INTENT(in) :: kwrite ! writing time-step 1910 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1911 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1912 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1913 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1914 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1915 LOGICAL :: llx ! local xios write flag 1916 INTEGER :: ivid ! variable id 1917 1918 llx = .FALSE. 1919 IF(PRESENT(ldxios)) llx = ldxios 1920 IF( llx ) THEN 1921 #ifdef key_iomput 1922 IF( kt == kwrite ) THEN 1923 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1924 CALL xios_send_field(trim(cdvar), pvar) 1925 ENDIF 1926 #endif 1927 ELSE 1928 IF( kiomid > 0 ) THEN 1929 IF( iom_file(kiomid)%nfid > 0 ) THEN 1930 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1666 1931 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1667 1932 ENDIF 1668 1933 ENDIF 1669 1934 ENDIF 1670 END SUBROUTINE iom_rp3d 1935 END SUBROUTINE iom_rp3d_dp 1936 1671 1937 1672 1938 … … 1720 1986 !! INTERFACE iom_put 1721 1987 !!---------------------------------------------------------------------- 1722 SUBROUTINE iom_p0d ( cdname, pfield0d )1988 SUBROUTINE iom_p0d_sp( cdname, pfield0d ) 1723 1989 CHARACTER(LEN=*), INTENT(in) :: cdname 1724 REAL( wp) , INTENT(in) :: pfield0d1990 REAL(sp) , INTENT(in) :: pfield0d 1725 1991 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1726 1992 #if defined key_iomput … … 1731 1997 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings 1732 1998 #endif 1733 END SUBROUTINE iom_p0d 1734 1735 SUBROUTINE iom_p1d( cdname, pfield1d ) 1999 END SUBROUTINE iom_p0d_sp 2000 2001 SUBROUTINE iom_p0d_dp( cdname, pfield0d ) 2002 CHARACTER(LEN=*), INTENT(in) :: cdname 2003 REAL(dp) , INTENT(in) :: pfield0d 2004 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 2005 #if defined key_iomput 2006 !!clem zz(:,:)=pfield0d 2007 !!clem CALL xios_send_field(cdname, zz) 2008 CALL xios_send_field(cdname, (/pfield0d/)) 2009 #else 2010 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings 2011 #endif 2012 END SUBROUTINE iom_p0d_dp 2013 2014 2015 SUBROUTINE iom_p1d_sp( cdname, pfield1d ) 1736 2016 CHARACTER(LEN=*) , INTENT(in) :: cdname 1737 REAL( wp), DIMENSION(:), INTENT(in) :: pfield1d2017 REAL(sp), DIMENSION(:), INTENT(in) :: pfield1d 1738 2018 #if defined key_iomput 1739 2019 CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) … … 1741 2021 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 1742 2022 #endif 1743 END SUBROUTINE iom_p1d 1744 1745 SUBROUTINE iom_p2d( cdname, pfield2d ) 2023 END SUBROUTINE iom_p1d_sp 2024 2025 SUBROUTINE iom_p1d_dp( cdname, pfield1d ) 2026 CHARACTER(LEN=*) , INTENT(in) :: cdname 2027 REAL(dp), DIMENSION(:), INTENT(in) :: pfield1d 2028 #if defined key_iomput 2029 CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 2030 #else 2031 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 2032 #endif 2033 END SUBROUTINE iom_p1d_dp 2034 2035 SUBROUTINE iom_p2d_sp( cdname, pfield2d ) 1746 2036 CHARACTER(LEN=*) , INTENT(in) :: cdname 1747 REAL( wp), DIMENSION(:,:), INTENT(in) :: pfield2d2037 REAL(sp), DIMENSION(:,:), INTENT(in) :: pfield2d 1748 2038 #if defined key_iomput 1749 2039 CALL xios_send_field(cdname, pfield2d) … … 1751 2041 IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings 1752 2042 #endif 1753 END SUBROUTINE iom_p2d 1754 1755 SUBROUTINE iom_p3d( cdname, pfield3d ) 2043 END SUBROUTINE iom_p2d_sp 2044 2045 SUBROUTINE iom_p2d_dp( cdname, pfield2d ) 2046 CHARACTER(LEN=*) , INTENT(in) :: cdname 2047 REAL(dp), DIMENSION(:,:), INTENT(in) :: pfield2d 2048 #if defined key_iomput 2049 CALL xios_send_field(cdname, pfield2d) 2050 #else 2051 IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings 2052 #endif 2053 END SUBROUTINE iom_p2d_dp 2054 2055 SUBROUTINE iom_p3d_sp( cdname, pfield3d ) 1756 2056 CHARACTER(LEN=*) , INTENT(in) :: cdname 1757 REAL( wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d2057 REAL(sp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1758 2058 #if defined key_iomput 1759 2059 CALL xios_send_field( cdname, pfield3d ) … … 1761 2061 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 1762 2062 #endif 1763 END SUBROUTINE iom_p3d 1764 1765 SUBROUTINE iom_p 4d( cdname, pfield4d )2063 END SUBROUTINE iom_p3d_sp 2064 2065 SUBROUTINE iom_p3d_dp( cdname, pfield3d ) 1766 2066 CHARACTER(LEN=*) , INTENT(in) :: cdname 1767 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 2067 REAL(dp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 2068 #if defined key_iomput 2069 CALL xios_send_field( cdname, pfield3d ) 2070 #else 2071 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 2072 #endif 2073 END SUBROUTINE iom_p3d_dp 2074 2075 SUBROUTINE iom_p4d_sp( cdname, pfield4d ) 2076 CHARACTER(LEN=*) , INTENT(in) :: cdname 2077 REAL(sp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1768 2078 #if defined key_iomput 1769 2079 CALL xios_send_field(cdname, pfield4d) … … 1771 2081 IF( .FALSE. ) WRITE(numout,*) cdname, pfield4d ! useless test to avoid compilation warnings 1772 2082 #endif 1773 END SUBROUTINE iom_p4d 1774 2083 END SUBROUTINE iom_p4d_sp 2084 2085 SUBROUTINE iom_p4d_dp( cdname, pfield4d ) 2086 CHARACTER(LEN=*) , INTENT(in) :: cdname 2087 REAL(dp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 2088 #if defined key_iomput 2089 CALL xios_send_field(cdname, pfield4d) 2090 #else 2091 IF( .FALSE. ) WRITE(numout,*) cdname, pfield4d ! useless test to avoid compilation warnings 2092 #endif 2093 END SUBROUTINE iom_p4d_dp 1775 2094 1776 2095 #if defined key_iomput … … 1788 2107 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1789 2108 INTEGER , OPTIONAL, INTENT(in) :: nvertex 1790 REAL( wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue1791 REAL( wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area2109 REAL(dp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 2110 REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1792 2111 LOGICAL , DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1793 2112 !!---------------------------------------------------------------------- … … 1852 2171 !!---------------------------------------------------------------------- 1853 2172 IF( PRESENT(paxis) ) THEN 1854 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1855 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1856 ENDIF 1857 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1858 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 2173 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 2174 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 2175 ENDIF 2176 IF( PRESENT(bounds) ) THEN 2177 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=real(bounds, dp) ) 2178 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) ) 2179 ELSE 2180 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid) 2181 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid) 2182 END IF 1859 2183 CALL xios_solve_inheritance() 1860 2184 END SUBROUTINE iom_set_axis_attr … … 1975 2299 !don't define lon and lat for restart reading context. 1976 2300 IF ( .NOT.ldrxios ) & 1977 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &1978 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))2301 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), dp), & 2302 & latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp ) ) 1979 2303 ! 1980 2304 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 1982 2306 SELECT CASE ( cdgrd ) 1983 2307 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1984 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( 'iom', zmask, 'U', 1. )1985 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( 'iom', zmask, 'V', 1. )2308 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp ) 2309 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp ) 1986 2310 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1987 2311 END SELECT … … 2026 2350 ! 2027 2351 z_fld(:,:) = 1._wp 2028 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. ) ! Working array for location of northfold2352 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp ) ! Working array for location of northfold 2029 2353 ! 2030 2354 ! Cell vertices that can be defined … … 2044 2368 ! Cell vertices on boundries 2045 2369 DO jn = 1, 4 2046 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1. , pfillval=999._wp )2047 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1. , pfillval=999._wp )2370 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp ) 2371 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp ) 2048 2372 END DO 2049 2373 ! … … 2091 2415 ENDIF 2092 2416 ! 2093 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), &2094 & bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )2417 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), dp), & 2418 & bounds_lon =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), dp), nvertex=4 ) 2095 2419 ! 2096 2420 DEALLOCATE( z_bnds, z_fld, z_rot ) … … 2116 2440 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 2117 2441 ! 2118 ! CALL dom_ngb( -168.53 , 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots)2119 CALL dom_ngb( 180. , 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)2442 ! CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2443 CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 2120 2444 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 2121 2445 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 2122 CALL iom_set_domain_attr("gznl", lonvalue = zlon, &2123 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))2446 CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), & 2447 & latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp)) 2124 2448 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 2125 2449 ! … … 2136 2460 !! 2137 2461 !!---------------------------------------------------------------------- 2138 REAL( wp), DIMENSION(1) :: zz = 1.2462 REAL(dp), DIMENSION(1) :: zz = 1. 2139 2463 !!---------------------------------------------------------------------- 2140 2464 ! … … 2198 2522 cl1 = clgrd(jg) 2199 2523 ! Equatorial section (attributs: jbegin, ni, name_suffix) 2200 CALL dom_ngb( 0. , 0., ix, iy, cl1 )2524 CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 2201 2525 CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 2202 2526 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) … … 2424 2748 ! 2425 2749 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 2426 CALL ju2ymds( pjday - 1. , iyear, imonth, iday, zsec )2750 CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 2427 2751 isec = 86400 2428 2752 ENDIF … … 2482 2806 CHARACTER(LEN=*), INTENT(in ) :: cdname 2483 2807 REAL(wp) , INTENT(out) :: pmiss_val 2808 REAL(dp) :: ztmp_pmiss_val 2484 2809 #if defined key_iomput 2485 2810 ! get missing value 2486 CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 2811 CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val ) 2812 pmiss_val = ztmp_pmiss_val 2487 2813 #else 2488 2814 IF( .FALSE. ) WRITE(numout,*) cdname, pmiss_val ! useless test to avoid compilation warnings
Note: See TracChangeset
for help on using the changeset viewer.
