Changeset 2870 for LMDZ5/branches/testing/libf/phylmd/iophy.F90
- Timestamp:
- May 4, 2017, 9:31:05 AM (7 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 2843-2844,2846-2865
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/iophy.F90
r2669 r2870 45 45 46 46 SUBROUTINE init_iophy_new(rlat,rlon) 47 USE dimphy, only: klon48 USE mod_phys_lmdz_para, only: gather, bcast, &47 USE dimphy, ONLY: klon 48 USE mod_phys_lmdz_para, ONLY: gather, bcast, & 49 49 jj_nb, jj_begin, jj_end, ii_begin, ii_end, & 50 50 mpi_size, mpi_rank, klon_mpi, & 51 51 is_sequential, is_south_pole_dyn 52 USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo52 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo 53 53 USE print_control_mod, ONLY: prt_level,lunout 54 54 #ifdef CPP_IOIPSL 55 USE ioipsl, only: flio_dom_set56 #endif 57 #ifdef CPP_XIOS 58 use wxios, only: wxios_domain_param55 USE ioipsl, ONLY: flio_dom_set 56 #endif 57 #ifdef CPP_XIOS 58 USE wxios, ONLY: wxios_domain_param 59 59 #endif 60 60 IMPLICIT NONE … … 136 136 ELSE 137 137 data_ibegin = ii_begin - 1 138 END 138 ENDIF 139 139 140 140 IF (mpi_rank == mpi_size-1) THEN … … 142 142 ELSE 143 143 data_iend = ii_end + 1 144 END 145 146 if (prt_level>=10) then144 ENDIF 145 146 IF (prt_level>=10) THEN 147 147 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 148 148 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat … … 150 150 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 151 151 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn 152 endif152 ENDIF 153 153 154 154 ! Initialize the XIOS domain coreesponding to this process: … … 163 163 164 164 SUBROUTINE init_iophy(lat,lon) 165 USE mod_phys_lmdz_para, only: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &165 USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, & 166 166 mpi_size, mpi_rank 167 USE ioipsl, only: flio_dom_set167 USE ioipsl, ONLY: flio_dom_set 168 168 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 169 169 IMPLICIT NONE … … 180 180 181 181 !$OMP MASTER 182 allocate(io_lat(nbp_lat))182 ALLOCATE(io_lat(nbp_lat)) 183 183 io_lat(:)=lat(:) 184 allocate(io_lon(nbp_lon))184 ALLOCATE(io_lon(nbp_lon)) 185 185 io_lon(:)=lon(:) 186 186 … … 191 191 dpl=(/ nbp_lon, jj_end /) 192 192 dhs=(/ ii_begin-1,0 /) 193 if (mpi_rank==mpi_size-1) then193 IF (mpi_rank==mpi_size-1) THEN 194 194 dhe=(/0,0/) 195 else195 ELSE 196 196 dhe=(/ nbp_lon-ii_end,0 /) 197 endif197 ENDIF 198 198 199 199 #ifndef CPP_IOIPSL_NO_OUTPUT … … 203 203 !$OMP END MASTER 204 204 205 endSUBROUTINE init_iophy205 END SUBROUTINE init_iophy 206 206 207 207 SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day) 208 208 ! USE dimphy 209 USE mod_phys_lmdz_para, only: is_sequential, is_using_mpi, is_mpi_root, &209 USE mod_phys_lmdz_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, & 210 210 jj_begin, jj_end, jj_nb 211 211 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 212 use ioipsl, only: histbeg213 #ifdef CPP_XIOS 214 use wxios, only: wxios_add_file212 USE ioipsl, ONLY: histbeg 213 #ifdef CPP_XIOS 214 USE wxios, ONLY: wxios_add_file 215 215 #endif 216 216 IMPLICIT NONE 217 217 include 'clesphys.h' 218 218 219 character*(*), INTENT(IN) :: name220 integer, INTENT(IN) :: itau0219 CHARACTER*(*), INTENT(IN) :: name 220 INTEGER, INTENT(IN) :: itau0 221 221 REAL,INTENT(IN) :: zjulian 222 222 REAL,INTENT(IN) :: dtime 223 character(LEN=*), INTENT(IN) :: ffreq223 CHARACTER(LEN=*), INTENT(IN) :: ffreq 224 224 INTEGER,INTENT(IN) :: lev 225 integer,intent(out) :: nhori226 integer,intent(out) :: nid_day225 INTEGER,INTENT(OUT) :: nhori 226 INTEGER,INTENT(OUT) :: nid_day 227 227 228 228 !$OMP MASTER 229 if (is_sequential) then229 IF (is_sequential) THEN 230 230 call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & 231 231 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day) 232 else232 ELSE 233 233 call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & 234 234 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id) 235 endif235 ENDIF 236 236 237 237 #ifdef CPP_XIOS … … 242 242 CALL wxios_add_file(name, ffreq, lev) 243 243 ENDIF 244 END 244 ENDIF 245 245 #endif 246 246 !$OMP END MASTER … … 250 250 SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day) 251 251 252 USE mod_phys_lmdz_para, only: jj_begin, jj_end, jj_nb, is_sequential252 USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential 253 253 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 254 use ioipsl, only: histbeg254 USE ioipsl, ONLY: histbeg 255 255 256 256 IMPLICIT NONE 257 257 258 character*(*), INTENT(IN) :: name259 integer, INTENT(IN) :: itau0258 CHARACTER*(*), INTENT(IN) :: name 259 INTEGER, INTENT(IN) :: itau0 260 260 REAL,INTENT(IN) :: zjulian 261 261 REAL,INTENT(IN) :: dtime 262 integer,intent(out) :: nhori263 integer,intent(out) :: nid_day262 INTEGER,INTENT(OUT) :: nhori 263 INTEGER,INTENT(OUT) :: nid_day 264 264 265 265 !$OMP MASTER 266 266 #ifndef CPP_IOIPSL_NO_OUTPUT 267 if (is_sequential) then267 IF (is_sequential) THEN 268 268 call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & 269 269 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day) 270 else270 ELSE 271 271 call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & 272 272 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id) 273 endif273 ENDIF 274 274 #endif 275 275 !$OMP END MASTER … … 281 281 plon,plat,plon_bounds,plat_bounds, & 282 282 nname,itau0,zjulian,dtime,nnhori,nnid_day) 283 USE dimphy, only: klon284 USE mod_phys_lmdz_para, only: gather, bcast, &283 USE dimphy, ONLY: klon 284 USE mod_phys_lmdz_para, ONLY: gather, bcast, & 285 285 is_sequential, klon_mpi_begin, klon_mpi_end, & 286 286 mpi_rank 287 USE mod_grid_phy_lmdz, only: klon_glo, nbp_lon, nbp_lat288 use ioipsl, only: histbeg287 USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat 288 USE ioipsl, ONLY: histbeg 289 289 290 290 IMPLICIT NONE … … 292 292 REAL,DIMENSION(klon),INTENT(IN) :: rlon 293 293 REAL,DIMENSION(klon),INTENT(IN) :: rlat 294 integer, INTENT(IN) :: itau0294 INTEGER, INTENT(IN) :: itau0 295 295 REAL,INTENT(IN) :: zjulian 296 296 REAL,INTENT(IN) :: dtime 297 integer, INTENT(IN) :: pim298 integer, intent(out) :: nnhori299 character(len=20), INTENT(IN) :: nname300 INTEGER, intent(out) :: nnid_day301 integer:: i297 INTEGER, INTENT(IN) :: pim 298 INTEGER, intent(out) :: nnhori 299 CHARACTER(len=20), INTENT(IN) :: nname 300 INTEGER, INTENT(OUT) :: nnid_day 301 INTEGER :: i 302 302 REAL,DIMENSION(klon_glo) :: rlat_glo 303 303 REAL,DIMENSION(klon_glo) :: rlon_glo … … 328 328 plon_bounds(i,1)=rlon_glo(tabij(i)-1) 329 329 plon_bounds(i,2)=rlon_glo(tabij(i)+1) 330 if(plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN331 if(rlon_glo(tabij(i)).GE.0.) THEN330 IF (plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN 331 IF (rlon_glo(tabij(i)).GE.0.) THEN 332 332 plon_bounds(i,2)=-1*plon_bounds(i,2) 333 endif334 endif335 if(plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN336 if(rlon_glo(tabij(i)).LE.0.) THEN333 ENDIF 334 ENDIF 335 IF (plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN 336 IF (rlon_glo(tabij(i)).LE.0.) THEN 337 337 plon_bounds(i,2)=-1*plon_bounds(i,2) 338 endif339 endif338 ENDIF 339 ENDIF 340 340 ! 341 341 IF ( tabij(i).LE.nbp_lon) THEN … … 361 361 362 362 CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon_glo,zx_lon) 363 if ((nbp_lon*nbp_lat).gt.1) then363 IF ((nbp_lon*nbp_lat).GT.1) THEN 364 364 DO i = 1, nbp_lon 365 365 zx_lon(i,1) = rlon_glo(i+1) 366 366 zx_lon(i,nbp_lat) = rlon_glo(i+1) 367 367 ENDDO 368 endif368 ENDIF 369 369 CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat_glo,zx_lat) 370 370 … … 375 375 plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i)) 376 376 377 if (ipt(i).EQ.1) then377 IF (ipt(i).EQ.1) THEN 378 378 plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i)) 379 379 plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i)) 380 endif380 ENDIF 381 381 382 if (ipt(i).EQ.nbp_lon) then382 IF (ipt(i).EQ.nbp_lon) THEN 383 383 plon_bounds(i,2)=360.+zx_lon(1,jpt(i)) 384 endif384 ENDIF 385 385 386 386 plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1) 387 387 plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1) 388 388 389 if (jpt(i).EQ.1) then389 IF (jpt(i).EQ.1) THEN 390 390 plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001 391 391 plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001 392 endif392 ENDIF 393 393 394 if (jpt(i).EQ.nbp_lat) then394 IF (jpt(i).EQ.nbp_lat) THEN 395 395 plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001 396 396 plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001 397 endif397 ENDIF 398 398 ! 399 399 ! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2) … … 407 407 itau0, zjulian, dtime, nnhori, nnid_day) 408 408 #endif 409 else409 ELSE 410 410 npproc=0 411 411 DO ip=1, pim … … 448 448 itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id) 449 449 #endif 450 endif450 ENDIF 451 451 !$OMP END MASTER 452 452 453 endSUBROUTINE histbeg_phy_points453 END SUBROUTINE histbeg_phy_points 454 454 455 455 456 456 SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar) 457 457 458 USE ioipsl, only: histdef459 USE mod_phys_lmdz_para, only: jj_nb460 use phys_output_var_mod, only: type_ecri, zoutm, zdtime_moy, lev_files, &461 nid_files, nhorim, swaero_diag, nfiles458 USE ioipsl, ONLY: histdef 459 USE mod_phys_lmdz_para, ONLY: jj_nb 460 USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, & 461 nid_files, nhorim, swaero_diag, dryaod_diag, nfiles 462 462 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 463 USE aero_mod, ONLY : naero_tot, name_aero_tau 464 463 465 IMPLICIT NONE 464 466 … … 466 468 467 469 INTEGER :: iff 470 INTEGER :: naero 468 471 LOGICAL :: lpoint 469 472 INTEGER, DIMENSION(nfiles) :: flag_var 470 CHARACTER(LEN=20) 473 CHARACTER(LEN=20) :: nomvar 471 474 CHARACTER(LEN=*) :: titrevar 472 475 CHARACTER(LEN=*) :: unitvar … … 498 501 499 502 ! Set swaero_diag=true if at least one of the concerned variables are defined 500 IF (nomvar=='topswad' .OR. nomvar=='topswai' .OR. nomvar=='solswad' .OR. nomvar=='solswai' ) THEN 501 IF ( flag_var(iff)<=lev_files(iff) ) THEN 502 swaero_diag=.TRUE. 503 END IF 504 END IF 503 IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. & 504 nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. & 505 nomvar=='topswai' .OR. nomvar=='solswai' ) THEN 506 IF ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE. 507 ENDIF 508 509 ! Set dryaod_diag=true if at least one of the concerned variables are defined 510 IF (nomvar=='dryod550aer') THEN 511 IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. 512 ENDIF 513 DO naero = 1, naero_tot-1 514 IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN 515 IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. 516 ENDIF 517 ENDDO 518 505 519 END SUBROUTINE histdef2d_old 506 520 507 508 509 521 SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar) 510 522 511 USE ioipsl, only: histdef512 USE dimphy, only: klev513 USE mod_phys_lmdz_para, only: jj_nb514 use phys_output_var_mod, only: type_ecri, zoutm, lev_files, nid_files, &523 USE ioipsl, ONLY: histdef 524 USE dimphy, ONLY: klev 525 USE mod_phys_lmdz_para, ONLY: jj_nb 526 USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, & 515 527 nhorim, zdtime_moy, levmin, levmax, & 516 528 nvertm, nfiles … … 555 567 END SUBROUTINE histdef3d_old 556 568 557 558 559 560 561 562 563 564 569 SUBROUTINE histdef2d (iff,var) 565 570 566 USE ioipsl, only: histdef567 USE mod_phys_lmdz_para, only: jj_nb568 use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &571 USE ioipsl, ONLY: histdef 572 USE mod_phys_lmdz_para, ONLY: jj_nb 573 USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, & 569 574 clef_stations, phys_out_filenames, lev_files, & 570 nid_files, nhorim, swaero_diag 575 nid_files, nhorim, swaero_diag, dryaod_diag 571 576 USE print_control_mod, ONLY: prt_level,lunout 572 577 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 573 #ifdef CPP_XIOS 574 use wxios, only: wxios_add_field_to_file 578 USE aero_mod, ONLY : naero_tot, name_aero_tau 579 #ifdef CPP_XIOS 580 USE wxios, ONLY: wxios_add_field_to_file 575 581 #endif 576 582 IMPLICIT NONE … … 579 585 580 586 INTEGER :: iff 587 INTEGER :: naero 581 588 TYPE(ctrl_out) :: var 582 589 583 590 REAL zstophym 584 591 CHARACTER(LEN=20) :: typeecrit 585 586 592 587 593 ! ug On récupère le type écrit de la structure: … … 638 644 ENDIF 639 645 640 ! Set swaero_diag=true if at least one of the concerned variables are 641 ! defined 646 ! Set swaero_diag=true if at least one of the concerned variables are defined 642 647 !--OB 30/05/2016 use wider set of variables 643 648 IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. & … … 645 650 var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. & 646 651 var%name=='toplwai' .OR. var%name=='sollwai' ) ) ) THEN 647 IF ( var%flag(iff)<=lev_files(iff) ) THEN 648 swaero_diag=.TRUE. 649 END IF 650 END IF 652 IF ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE. 653 ENDIF 654 655 ! set dryaod_dry=true if at least one of the concerned variables are defined 656 IF (var%name=='dryod550aer') THEN 657 IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. 658 ENDIF 659 ! 660 DO naero = 1, naero_tot-1 661 IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN 662 IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. 663 ENDIF 664 ENDDO 651 665 END SUBROUTINE histdef2d 652 666 653 667 SUBROUTINE histdef3d (iff,var) 654 668 655 USE ioipsl, only: histdef656 USE dimphy, only: klev657 USE mod_phys_lmdz_para, only: jj_nb658 use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &669 USE ioipsl, ONLY: histdef 670 USE dimphy, ONLY: klev 671 USE mod_phys_lmdz_para, ONLY: jj_nb 672 USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, & 659 673 clef_stations, phys_out_filenames, lev_files, & 660 nid_files, nhorim, swaero_diag, levmin, &674 nid_files, nhorim, swaero_diag, dryaod_diag, levmin, & 661 675 levmax, nvertm 662 676 USE print_control_mod, ONLY: prt_level,lunout 663 677 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 664 678 #ifdef CPP_XIOS 665 use wxios, only: wxios_add_field_to_file679 USE wxios, ONLY: wxios_add_field_to_file 666 680 #endif 667 681 IMPLICIT NONE … … 735 749 !!! Lecture des noms et niveau de sortie des variables dans output.def 736 750 ! en utilisant les routines getin de IOIPSL 737 use ioipsl, only: getin738 use phys_output_var_mod, only: nfiles751 USE ioipsl, ONLY: getin 752 USE phys_output_var_mod, ONLY: nfiles 739 753 USE print_control_mod, ONLY: prt_level,lunout 740 754 IMPLICIT NONE … … 750 764 END SUBROUTINE conf_physoutputs 751 765 752 753 766 754 767 SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field) 755 USE dimphy, only: klon756 USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &768 USE dimphy, ONLY: klon 769 USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, & 757 770 is_sequential, klon_mpi_begin, klon_mpi_end, & 758 771 jj_nb, klon_mpi 759 USE ioipsl, only: histwrite772 USE ioipsl, ONLY: histwrite 760 773 USE print_control_mod, ONLY: prt_level,lunout 761 774 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 762 775 IMPLICIT NONE 763 776 764 integer,INTENT(IN) :: nid765 logical,INTENT(IN) :: lpoint766 character*(*), INTENT(IN) :: name767 integer, INTENT(IN) :: itau777 INTEGER,INTENT(IN) :: nid 778 LOGICAL,INTENT(IN) :: lpoint 779 CHARACTER*(*), INTENT(IN) :: name 780 INTEGER, INTENT(IN) :: itau 768 781 REAL,DIMENSION(:),INTENT(IN) :: field 769 782 REAL,DIMENSION(klon_mpi) :: buffer_omp … … 771 784 REAL :: Field2d(nbp_lon,jj_nb) 772 785 773 integer :: ip 774 REAL,allocatable,DIMENSION(:) :: fieldok 775 786 INTEGER :: ip 787 REAL,ALLOCATABLE,DIMENSION(:) :: fieldok 776 788 777 789 IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1) … … 786 798 CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d) 787 799 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' 788 else800 ELSE 789 801 ALLOCATE(fieldok(npstn)) 790 802 ALLOCATE(index2d(npstn)) 791 803 792 if(is_sequential) then804 IF (is_sequential) THEN 793 805 ! klon_mpi_begin=1 794 806 ! klon_mpi_end=klon … … 796 808 fieldok(ip)=buffer_omp(nptabij(ip)) 797 809 ENDDO 798 else810 ELSE 799 811 DO ip=1, npstn 800 812 ! print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip) … … 804 816 ENDIF 805 817 ENDDO 806 endif818 ENDIF 807 819 IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL' 808 820 CALL histwrite(nid,name,itau,fieldok,npstn,index2d) 809 821 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' 810 822 ! 811 endif812 deallocate(index2d)813 deallocate(fieldok)823 ENDIF 824 DEALLOCATE(index2d) 825 DEALLOCATE(fieldok) 814 826 !$OMP END MASTER 815 827 816 828 817 endSUBROUTINE histwrite2d_phy_old829 END SUBROUTINE histwrite2d_phy_old 818 830 819 831 SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field) 820 USE dimphy, only: klon821 USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &832 USE dimphy, ONLY: klon 833 USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, & 822 834 is_sequential, klon_mpi_begin, klon_mpi_end, & 823 835 jj_nb, klon_mpi 824 836 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 825 use ioipsl, only: histwrite837 USE ioipsl, ONLY: histwrite 826 838 USE print_control_mod, ONLY: prt_level,lunout 827 839 IMPLICIT NONE 828 840 829 integer,INTENT(IN) :: nid830 logical,INTENT(IN) :: lpoint831 character*(*), INTENT(IN) :: name832 integer, INTENT(IN) :: itau841 INTEGER,INTENT(IN) :: nid 842 LOGICAL,INTENT(IN) :: lpoint 843 CHARACTER*(*), INTENT(IN) :: name 844 INTEGER, INTENT(IN) :: itau 833 845 REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:) 834 846 REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp … … 845 857 !$OMP MASTER 846 858 CALL grid1Dto2D_mpi(buffer_omp,field3d) 847 if(.NOT.lpoint) THEN859 IF (.NOT.lpoint) THEN 848 860 ALLOCATE(index3d(nbp_lon*jj_nb*nlev)) 849 861 ALLOCATE(fieldok(nbp_lon*jj_nb,nlev)) … … 851 863 CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d) 852 864 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' 853 else865 ELSE 854 866 nlev=size(field,2) 855 867 ALLOCATE(index3d(npstn*nlev)) 856 868 ALLOCATE(fieldok(npstn,nlev)) 857 869 858 if(is_sequential) then870 IF (is_sequential) THEN 859 871 ! klon_mpi_begin=1 860 872 ! klon_mpi_end=klon … … 864 876 ENDDO 865 877 ENDDO 866 else878 ELSE 867 879 DO n=1, nlev 868 880 DO ip=1, npstn … … 873 885 ENDDO 874 886 ENDDO 875 endif887 ENDIF 876 888 IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL' 877 889 CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d) 878 890 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' 879 endif880 deallocate(index3d)881 deallocate(fieldok)891 ENDIF 892 DEALLOCATE(index3d) 893 DEALLOCATE(fieldok) 882 894 !$OMP END MASTER 883 895 884 endSUBROUTINE histwrite3d_phy_old896 END SUBROUTINE histwrite3d_phy_old 885 897 886 898 … … 889 901 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE 890 902 SUBROUTINE histwrite2d_phy(var,field, STD_iff) 891 USE dimphy, only: klon892 USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &903 USE dimphy, ONLY: klon 904 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, & 893 905 jj_nb, klon_mpi, klon_mpi_begin, & 894 906 klon_mpi_end, is_sequential 895 USE ioipsl, only: histwrite896 use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &907 USE ioipsl, ONLY: histwrite 908 USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, & 897 909 nfiles, vars_defined, clef_stations, & 898 910 nid_files … … 900 912 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 901 913 #ifdef CPP_XIOS 902 USE xios, only: xios_send_field914 USE xios, ONLY: xios_send_field 903 915 #endif 904 916 … … 932 944 iff_beg = 1 933 945 iff_end = nfiles 934 END 946 ENDIF 935 947 936 948 ! On regarde si on est dans la phase de définition ou d'écriture: 937 IF (.NOT.vars_defined) THEN949 IF (.NOT.vars_defined) THEN 938 950 !$OMP MASTER 939 951 !Si phase de définition.... on définit 940 952 IF (.not. ok_all_xml) THEN 941 if (prt_level >= 10) then 942 write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", & 943 trim(var%name) 944 endif 953 IF (prt_level >= 10) THEN 954 WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", trim(var%name) 955 ENDIF 945 956 DO iff=iff_beg, iff_end 946 957 IF (clef_files(iff)) THEN … … 955 966 IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon',1) 956 967 957 if (prt_level >= 10) then 958 write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", & 959 trim(var%name) 960 endif 968 IF (prt_level >= 10) THEn 969 WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name) 970 ENDIF 961 971 962 972 CALL Gather_omp(field,buffer_omp) … … 969 979 IF (ok_all_xml) THEN 970 980 #ifdef CPP_XIOS 971 if (prt_level >= 10) then 972 write(lunout,*)'Dans iophy histwrite2D,var%name ',& 973 trim(var%name) 974 endif 981 IF (prt_level >= 10) THEN 982 write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name) 983 ENDIF 975 984 CALL xios_send_field(var%name, Field2d) 976 if (prt_level >= 10) then 977 write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',& 978 trim(var%name) 979 endif 985 IF (prt_level >= 10) THEN 986 WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name) 987 ENDIF 980 988 #else 981 989 CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1) … … 987 995 #ifdef CPP_XIOS 988 996 IF (firstx) THEN 989 if (prt_level >= 10) then 990 write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',& 991 iff,trim(var%name) 992 write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" 993 endif 997 IF (prt_level >= 10) THEN 998 WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name) 999 WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" 1000 ENDIF 994 1001 CALL xios_send_field(var%name, Field2d) 995 1002 firstx=.false. … … 997 1004 #endif 998 1005 999 IF (.NOT.clef_stations(iff)) THEN1006 IF (.NOT.clef_stations(iff)) THEN 1000 1007 ALLOCATE(index2d(nbp_lon*jj_nb)) 1001 1008 ALLOCATE(fieldok(nbp_lon*jj_nb)) … … 1029 1036 ENDIF ! of IF (is_sequential) 1030 1037 #ifndef CPP_IOIPSL_NO_OUTPUT 1031 if (prt_level >= 10) then1038 IF (prt_level >= 10) THEn 1032 1039 write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D" 1033 endif1040 ENDIF 1034 1041 CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d) 1035 1042 #endif 1036 1043 ENDIF ! of IF(.NOT.clef_stations(iff)) 1037 1044 1038 deallocate(index2d)1039 deallocate(fieldok)1045 DEALLOCATE(index2d) 1046 DEALLOCATE(fieldok) 1040 1047 ENDIF !levfiles 1041 1048 ENDDO ! of DO iff=iff_beg, iff_end … … 1049 1056 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE 1050 1057 SUBROUTINE histwrite3d_phy(var, field, STD_iff) 1051 USE dimphy, only: klon, klev1052 USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &1058 USE dimphy, ONLY: klon, klev 1059 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, & 1053 1060 jj_nb, klon_mpi, klon_mpi_begin, & 1054 1061 klon_mpi_end, is_sequential 1055 USE ioipsl, only: histwrite1056 use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &1062 USE ioipsl, ONLY: histwrite 1063 USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, & 1057 1064 nfiles, vars_defined, clef_stations, & 1058 1065 nid_files 1059 1066 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1060 1067 #ifdef CPP_XIOS 1061 USE xios, only: xios_send_field1068 USE xios, ONLY: xios_send_field 1062 1069 #endif 1063 1070 USE print_control_mod, ONLY: prt_level,lunout … … 1088 1095 iff_beg = 1 1089 1096 iff_end = nfiles 1090 END 1097 ENDIF 1091 1098 1092 1099 ! On regarde si on est dans la phase de définition ou d'écriture: … … 1104 1111 IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) 1105 1112 nlev=SIZE(field,2) 1106 if (nlev.eq.klev+1) then1113 IF (nlev.EQ.klev+1) THEN 1107 1114 nlevx=klev 1108 else1115 ELSE 1109 1116 nlevx=nlev 1110 endif1117 ENDIF 1111 1118 1112 1119 CALL Gather_omp(field,buffer_omp) … … 1120 1127 IF (ok_all_xml) THEN 1121 1128 #ifdef CPP_XIOS 1122 if (prt_level >= 10) then1129 IF (prt_level >= 10) THEN 1123 1130 write(lunout,*)'Dans iophy histwrite3D,var%name ',& 1124 1131 trim(var%name) 1125 endif1132 ENDIF 1126 1133 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1127 1134 #else … … 1135 1142 #ifdef CPP_XIOS 1136 1143 IF (firstx) THEN 1137 if (prt_level >= 10) then1138 write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &1144 IF (prt_level >= 10) THEn 1145 WRITE (lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', & 1139 1146 iff,nlev,klev, firstx 1140 write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &1147 WRITE (lunout,*)'histwrite3d_phy: call xios_send_field for ', & 1141 1148 trim(var%name), ' with iim jjm nlevx = ', & 1142 1149 nbp_lon,jj_nb,nlevx 1143 endif1150 ENDIF 1144 1151 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1145 1152 firstx=.false. … … 1185 1192 #endif 1186 1193 ENDIF 1187 deallocate(index3d)1188 deallocate(fieldok)1194 DEALLOCATE(index3d) 1195 DEALLOCATE(fieldok) 1189 1196 ENDIF 1190 1197 ENDDO … … 1199 1206 #ifdef CPP_XIOS 1200 1207 SUBROUTINE histwrite2d_xios(field_name,field) 1201 USE dimphy, only: klon1202 USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &1208 USE dimphy, ONLY: klon 1209 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, & 1203 1210 is_sequential, klon_mpi_begin, klon_mpi_end, & 1204 1211 jj_nb, klon_mpi 1205 1212 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1206 USE xios, only: xios_send_field1213 USE xios, ONLY: xios_send_field 1207 1214 USE print_control_mod, ONLY: prt_level,lunout 1208 1215 … … 1259 1266 ENDIF 1260 1267 1261 deallocate(index2d)1262 deallocate(fieldok)1268 DEALLOCATE(index2d) 1269 DEALLOCATE(fieldok) 1263 1270 !$OMP END MASTER 1264 1271 … … 1269 1276 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE 1270 1277 SUBROUTINE histwrite3d_xios(field_name, field) 1271 USE dimphy, only: klon, klev1272 USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &1278 USE dimphy, ONLY: klon, klev 1279 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, & 1273 1280 is_sequential, klon_mpi_begin, klon_mpi_end, & 1274 1281 jj_nb, klon_mpi 1275 USE xios, only: xios_send_field1282 USE xios, ONLY: xios_send_field 1276 1283 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1277 1284 USE print_control_mod, ONLY: prt_level,lunout … … 1330 1337 ENDIF 1331 1338 ENDIF 1332 deallocate(index3d)1333 deallocate(fieldok)1339 DEALLOCATE(index3d) 1340 DEALLOCATE(fieldok) 1334 1341 !$OMP END MASTER 1335 1342 … … 1339 1346 #ifdef CPP_XIOS 1340 1347 SUBROUTINE histwrite0d_xios(field_name, field) 1341 USE xios, only: xios_send_field1348 USE xios, ONLY: xios_send_field 1342 1349 IMPLICIT NONE 1343 1350
Note: See TracChangeset
for help on using the changeset viewer.