Changeset 3077 for LMDZ6/branches/DYNAMICO-conv
- Timestamp:
- Nov 16, 2017, 12:12:53 PM (7 years ago)
- Location:
- LMDZ6/branches/DYNAMICO-conv/libf
- Files:
-
- 3 deleted
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/DYNAMICO-conv/libf/misc/wxios.F90
r3065 r3077 237 237 ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!! 238 238 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 239 SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo, & 240 ibegin, iend, ii_begin, ii_end, jbegin, jend, & 241 data_ni, data_ibegin, data_iend, & 242 io_lat, io_lon,is_south_pole,mpi_rank) 243 244 245 USE print_control_mod, ONLY : prt_level, lunout 246 IMPLICIT NONE 247 239 SUBROUTINE wxios_domain_param(dom_id) 240 USE dimphy, only: klon 241 USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast 242 USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, & 243 mpi_size, mpi_rank, klon_mpi, & 244 is_sequential, is_south_pole_dyn 245 USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo 246 USE print_control_mod, ONLY : prt_level, lunout 247 USE geometry_mod 248 249 IMPLICIT NONE 248 250 CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier 249 LOGICAL,INTENT(IN) :: is_sequential ! flag 250 INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes 251 INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes 252 INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes 253 INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes 254 INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain 255 INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain 256 INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row) 257 INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row) 258 INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain 259 INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain 260 INTEGER,INTENT(IN) :: data_ni 261 INTEGER,INTENT(IN) :: data_ibegin 262 INTEGER,INTENT(IN) :: data_iend 263 REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid) 264 REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid) 265 logical,intent(in) :: is_south_pole ! does this process include the south pole? 266 integer,intent(in) :: mpi_rank ! rank of process 267 251 252 REAL :: rlat_glo(klon_glo) 253 REAL :: rlon_glo(klon_glo) 254 REAL :: io_lat(nbp_lat) 255 REAL :: io_lon(nbp_lon) 256 LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI 268 257 TYPE(xios_domain) :: dom 258 INTEGER :: i 269 259 LOGICAL :: boool 270 260 271 !Masque pour les problèmes de recouvrement MPI: 272 LOGICAL :: mask(ni,nj) 261 262 263 CALL gather(latitude_deg,rlat_glo) 264 CALL bcast(rlat_glo) 265 CALL gather(longitude_deg,rlon_glo) 266 CALL bcast(rlon_glo) 267 268 !$OMP MASTER 269 io_lat(1)=rlat_glo(1) 270 io_lat(nbp_lat)=rlat_glo(klon_glo) 271 IF ((nbp_lon*nbp_lat) > 1) then 272 DO i=2,nbp_lat-1 273 io_lat(i)=rlat_glo(2+(i-2)*nbp_lon) 274 ENDDO 275 ENDIF 276 277 IF (klon_glo == 1) THEN 278 io_lon(1)=rlon_glo(1) 279 ELSE 280 io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1) 281 ENDIF 282 273 283 274 284 !On récupère le handle: 275 285 CALL xios_get_domain_handle(dom_id, dom) 276 286 277 IF (prt_level >= 10) THEN278 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo279 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend280 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end281 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))282 ENDIF283 284 287 !On parametrise le domaine: 285 CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin-1, ni=ni, type="rectilinear") 286 CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin-1, nj=nj, data_dim=2) 287 CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(ibegin:iend), latvalue_1d=io_lat(jbegin:jend)) 288 CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear") 289 CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2) 290 CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end)) 291 288 292 IF (.NOT.is_sequential) THEN 289 293 mask(:,:)=.TRUE. 290 294 if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE. 291 if (ii_end<n i) mask(ii_end+1:ni,nj) = .FALSE.295 if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE. 292 296 ! special case for south pole 293 if ((ii_end .eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.297 if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true. 294 298 IF (prt_level >= 10) THEN 295 299 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1) 296 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:, nj)=",mask(:,nj)300 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb) 297 301 ENDIF 298 302 CALL xios_set_domain_attr_hdl(dom, mask_2d=mask) … … 306 310 IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id) 307 311 END IF 312 !$OMP END MASTER 313 308 314 END SUBROUTINE wxios_domain_param 309 315 316 317 SUBROUTINE wxios_domain_param_unstructured(dom_id) 318 USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo 319 USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo 320 USE mod_phys_lmdz_para 321 USE nrtype, ONLY : PI 322 IMPLICIT NONE 323 CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier 324 REAL :: lon_mpi(klon_mpi) 325 REAL :: lat_mpi(klon_mpi) 326 REAL :: boundslon_mpi(klon_mpi,nvertex) 327 REAL :: boundslat_mpi(klon_mpi,nvertex) 328 INTEGER :: ind_cell_glo_mpi(klon_mpi) 329 TYPE(xios_domaingroup) :: dom 330 331 332 CALL gather_omp(longitude*180/PI,lon_mpi) 333 CALL gather_omp(latitude*180/PI,lat_mpi) 334 CALL gather_omp(boundslon*180/PI,boundslon_mpi) 335 CALL gather_omp(boundslat*180/PI,boundslat_mpi) 336 CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi) 337 338 339 !$OMP MASTER 340 CALL xios_get_domaingroup_handle(dom_id, dom) 341 342 !On parametrise le domaine: 343 CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured") 344 CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, & 345 bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) ) 346 CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1) 347 !$OMP END MASTER 348 349 END SUBROUTINE wxios_domain_param_unstructured 350 351 352 353 310 354 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 311 355 ! Pour déclarer un axe vertical !!!!!!!!!!!!!!! -
LMDZ6/branches/DYNAMICO-conv/libf/phylmd/iophy.F90
r3055 r3077 45 45 mpi_size, mpi_rank, klon_mpi, & 46 46 is_sequential, is_south_pole_dyn 47 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo 47 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured 48 48 USE print_control_mod, ONLY: prt_level,lunout 49 49 #ifdef CPP_IOIPSL … … 51 51 #endif 52 52 #ifdef CPP_XIOS 53 USE wxios, ONLY: wxios_domain_param53 use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init 54 54 #endif 55 55 IMPLICIT NONE … … 70 70 INTEGER :: data_ibegin, data_iend 71 71 72 CALL gather(rlat,rlat_glo) 73 CALL bcast(rlat_glo) 74 CALL gather(rlon,rlon_glo) 75 CALL bcast(rlon_glo) 72 !#ifdef CPP_XIOS 73 ! CALL wxios_context_init 74 !#endif 75 76 77 IF (grid_type==unstructured) THEN 78 79 #ifdef CPP_XIOS 80 CALL wxios_domain_param_unstructured("dom_glo") 81 #endif 82 83 ELSE 84 85 CALL gather(rlat,rlat_glo) 86 CALL bcast(rlat_glo) 87 CALL gather(rlon,rlon_glo) 88 CALL bcast(rlon_glo) 76 89 77 90 !$OMP MASTER … … 126 139 #endif 127 140 #ifdef CPP_XIOS 128 ! Set values for the mask: 129 IF (mpi_rank == 0) THEN 130 data_ibegin = 0 131 ELSE 132 data_ibegin = ii_begin - 1 133 ENDIF 134 135 IF (mpi_rank == mpi_size-1) THEN 136 data_iend = nbp_lon 137 ELSE 138 data_iend = ii_end + 1 139 ENDIF 140 141 IF (prt_level>=10) THEN 142 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end 143 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat 144 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 145 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 146 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn 147 ENDIF 148 149 ! Initialize the XIOS domain coreesponding to this process: 150 CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, & 151 1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end, & 152 klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend, & 153 io_lat, io_lon,is_south_pole_dyn,mpi_rank) 141 ! Set values for the mask: 142 IF (mpi_rank == 0) THEN 143 data_ibegin = 0 144 ELSE 145 data_ibegin = ii_begin - 1 146 END IF 147 148 IF (mpi_rank == mpi_size-1) THEN 149 data_iend = nbp_lon 150 ELSE 151 data_iend = ii_end + 1 152 END IF 153 154 IF (prt_level>=10) THEN 155 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end 156 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat 157 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 158 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 159 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn 160 ENDIF 161 162 ! Initialize the XIOS domain coreesponding to this process: 154 163 #endif 155 164 !$OMP END MASTER 165 166 #ifdef CPP_XIOS 167 CALL wxios_domain_param("dom_glo") 168 #endif 169 170 ENDIF 156 171 157 172 END SUBROUTINE init_iophy_new … … 925 940 nid_files 926 941 USE print_control_mod, ONLY: prt_level,lunout 927 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 942 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat 928 943 #ifdef CPP_XIOS 929 944 USE xios, ONLY: xios_send_field 930 945 #endif 931 946 USE print_control_mod, ONLY: lunout, prt_level 932 947 933 948 IMPLICIT NONE … … 967 982 IF (.not. ok_all_xml) THEN 968 983 IF (prt_level >= 10) THEN 969 WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", trim(var%name) 984 write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", & 985 trim(var%name) 970 986 ENDIF 971 987 DO iff=iff_beg, iff_end … … 991 1007 ENDIF 992 1008 !$OMP MASTER 993 CALL grid1Dto2D_mpi(buffer_omp,Field2d)1009 IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d) 994 1010 995 1011 ! La boucle sur les fichiers: … … 1001 1017 write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name) 1002 1018 ENDIF 1003 IF (SIZE(field) == klon) then 1019 1020 IF (grid_type==regular_lonlat) THEN 1021 IF (SIZE(field) == klon) then 1004 1022 CALL xios_send_field(var%name, Field2d) 1005 ELSE 1006 CALL xios_send_field(var%name, field) 1007 ENDIF 1023 ELSE 1024 CALL xios_send_field(var%name, field) 1025 ENDIF 1026 ELSE IF (grid_type==unstructured) THEN 1027 CALL xios_send_field(var%name, buffer_omp) 1028 ENDIF 1008 1029 IF (prt_level >= 10) THEN 1009 WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name) 1030 write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',& 1031 trim(var%name) 1010 1032 ENDIF 1011 1033 #else … … 1019 1041 IF (firstx) THEN 1020 1042 IF (prt_level >= 10) THEN 1021 WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name) 1022 WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" 1043 write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',& 1044 iff,trim(var%name) 1045 write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" 1023 1046 ENDIF 1024 IF (SIZE(field) == klon) then 1025 CALL xios_send_field(var%name, Field2d) 1026 ELSE 1027 CALL xios_send_field(var%name, field) 1047 IF (grid_type==regular_lonlat) THEN 1048 IF (SIZE(field) == klon) then 1049 CALL xios_send_field(var%name, Field2d) 1050 ELSE 1051 CALL xios_send_field(var%name, field) 1052 ENDIF 1053 ELSE IF (grid_type==unstructured) THEN 1054 CALL xios_send_field(var%name, buffer_omp) 1028 1055 ENDIF 1056 1029 1057 firstx=.false. 1030 1058 ENDIF … … 1039 1067 !#ifdef CPP_XIOS 1040 1068 ! IF (iff == iff_beg) THEN 1041 ! if (prt_level >= 10) then1069 ! IF (prt_level >= 10) THEN 1042 1070 ! write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field" 1043 ! endif1071 ! ENDIF 1044 1072 ! CALL xios_send_field(var%name, Field2d) 1045 1073 ! ENDIF … … 1063 1091 ENDIF ! of IF (is_sequential) 1064 1092 #ifndef CPP_IOIPSL_NO_OUTPUT 1065 IF (prt_level >= 10) THE n1093 IF (prt_level >= 10) THEN 1066 1094 write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D" 1067 1095 ENDIF … … 1091 1119 nfiles, vars_defined, clef_stations, & 1092 1120 nid_files 1093 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1121 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured 1094 1122 #ifdef CPP_XIOS 1095 1123 USE xios, ONLY: xios_send_field … … 1152 1180 ENDIF 1153 1181 !$OMP MASTER 1154 CALL grid1Dto2D_mpi(buffer_omp,field3d)1182 IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d) 1155 1183 1156 1184 … … 1164 1192 trim(var%name) 1165 1193 ENDIF 1166 IF (SIZE(field,1) == klon) then 1167 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1168 ELSE 1169 CALL xios_send_field(var%name, field) 1194 IF (grid_type==regular_lonlat) THEN 1195 IF (SIZE(field,1) == klon) then 1196 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1197 ELSE 1198 CALL xios_send_field(var%name, field) 1199 ENDIF 1200 ELSE IF (grid_type==unstructured) THEN 1201 CALL xios_send_field(var%name, buffer_omp(:,1:nlevx)) 1170 1202 ENDIF 1203 1171 1204 #else 1172 1205 CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1) … … 1179 1212 #ifdef CPP_XIOS 1180 1213 IF (firstx) THEN 1181 IF (prt_level >= 10) THE n1182 WRITE(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &1214 IF (prt_level >= 10) THEN 1215 write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', & 1183 1216 iff,nlev,klev, firstx 1184 WRITE(lunout,*)'histwrite3d_phy: call xios_send_field for ', &1217 write(lunout,*)'histwrite3d_phy: call xios_send_field for ', & 1185 1218 trim(var%name), ' with iim jjm nlevx = ', & 1186 1219 nbp_lon,jj_nb,nlevx 1187 1220 ENDIF 1188 IF (SIZE(field,1) == klon) then 1189 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1190 ELSE 1191 CALL xios_send_field(var%name, field) 1221 IF (grid_type==regular_lonlat) THEN 1222 IF (SIZE(field,1) == klon) then 1223 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1224 ELSE 1225 CALL xios_send_field(var%name, field) 1226 ENDIF 1227 ELSE IF (grid_type==unstructured) THEN 1228 CALL xios_send_field(var%name, buffer_omp(:,1:nlevx)) 1192 1229 ENDIF 1230 1193 1231 firstx=.false. 1194 1232 ENDIF … … 1251 1289 is_sequential, klon_mpi_begin, klon_mpi_end, & 1252 1290 jj_nb, klon_mpi 1253 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1291 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured 1254 1292 USE xios, ONLY: xios_send_field 1255 1293 USE print_control_mod, ONLY: prt_level,lunout … … 1279 1317 CALL Gather_omp(field,buffer_omp) 1280 1318 !$OMP MASTER 1319 1320 IF (grid_type==unstructured) THEN 1321 1322 CALL xios_send_field(field_name, buffer_omp) 1323 1324 ELSE 1325 1281 1326 CALL grid1Dto2D_mpi(buffer_omp,Field2d) 1282 1327 … … 1314 1359 DEALLOCATE(index2d) 1315 1360 DEALLOCATE(fieldok) 1361 ENDIF 1316 1362 !$OMP END MASTER 1317 1363 ENDIF … … 1328 1374 jj_nb, klon_mpi 1329 1375 USE xios, ONLY: xios_send_field 1330 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1376 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured 1331 1377 USE print_control_mod, ONLY: prt_level,lunout 1332 1378 … … 1357 1403 CALL Gather_omp(field,buffer_omp) 1358 1404 !$OMP MASTER 1405 1406 IF (grid_type==unstructured) THEN 1407 1408 CALL xios_send_field(field_name, buffer_omp(:,1:nlev)) 1409 1410 ELSE 1359 1411 CALL grid1Dto2D_mpi(buffer_omp,field3d) 1360 1412 … … 1392 1444 DEALLOCATE(index3d) 1393 1445 DEALLOCATE(fieldok) 1446 ENDIF 1394 1447 !$OMP END MASTER 1395 1448 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.