Changeset 1797 for LMDZ5/trunk/libf/phylmd/iophy.F90
- Timestamp:
- Jul 18, 2013, 3:32:27 PM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/iophy.F90
r1791 r1797 4 4 module iophy 5 5 6 ! abd REAL,private,allocatable, dimension(:),save :: io_lat7 ! abd REAL,private,allocatable, dimension(:),save :: io_lon6 ! abd REAL,private,allocatable,DIMENSION(:),save :: io_lat 7 ! abd REAL,private,allocatable,DIMENSION(:),save :: io_lon 8 8 REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat 9 9 REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon … … 24 24 25 25 26 contains 27 28 subroutine init_iophy_new(rlat,rlon) 26 CONTAINS 27 28 ! ug Routine pour définir itau_iophy depuis phys_output_write_mod: 29 SUBROUTINE set_itau_iophy(ito) 30 IMPLICIT NONE 31 INTEGER, INTENT(IN) :: ito 32 itau_iophy = ito 33 END SUBROUTINE 34 35 SUBROUTINE init_iophy_new(rlat,rlon) 29 36 USE dimphy 30 37 USE mod_phys_lmdz_para 31 38 USE mod_grid_phy_lmdz 32 39 USE ioipsl 33 implicit none34 include'dimensions.h'35 real,dimension(klon),intent(in) :: rlon36 real,dimension(klon),intent(in) :: rlat37 38 REAL, dimension(klon_glo) :: rlat_glo39 REAL, dimension(klon_glo) :: rlon_glo40 IMPLICIT NONE 41 INCLUDE 'dimensions.h' 42 REAL,DIMENSION(klon),INTENT(IN) :: rlon 43 REAL,DIMENSION(klon),INTENT(IN) :: rlat 44 45 REAL,DIMENSION(klon_glo) :: rlat_glo 46 REAL,DIMENSION(klon_glo) :: rlon_glo 40 47 41 48 INTEGER,DIMENSION(2) :: ddid … … 72 79 dpl=(/ iim, jj_end /) 73 80 dhs=(/ ii_begin-1,0 /) 74 if (mpi_rank==mpi_size-1) then81 IF (mpi_rank==mpi_size-1) THEN 75 82 dhe=(/0,0/) 76 else83 ELSE 77 84 dhe=(/ iim-ii_end,0 /) 78 endif79 80 callflio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &85 ENDIF 86 87 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & 81 88 'APPLE',phys_domain_id) 82 89 83 90 !$OMP END MASTER 84 91 85 end subroutineinit_iophy_new86 87 subroutineinit_iophy(lat,lon)88 USE dimphy 89 USE mod_phys_lmdz_para 90 useioipsl91 implicit none92 include'dimensions.h'93 real,dimension(iim),intent(in) :: lon94 real,dimension(jjm+1-1/(iim*jjm)),intent(in) :: lat92 END SUBROUTINE init_iophy_new 93 94 SUBROUTINE init_iophy(lat,lon) 95 USE dimphy 96 USE mod_phys_lmdz_para 97 USE ioipsl 98 IMPLICIT NONE 99 INCLUDE 'dimensions.h' 100 REAL,DIMENSION(iim),INTENT(IN) :: lon 101 REAL,DIMENSION(jjm+1-1/(iim*jjm)),INTENT(IN) :: lat 95 102 96 103 INTEGER,DIMENSION(2) :: ddid … … 125 132 !$OMP END MASTER 126 133 127 end subroutineinit_iophy128 129 subroutinehistbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)134 end SUBROUTINE init_iophy 135 136 SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day) 130 137 USE dimphy 131 138 USE mod_phys_lmdz_para 132 139 use ioipsl 133 140 use write_field 134 implicit none141 IMPLICIT NONE 135 142 include 'dimensions.h' 136 143 137 character*(*), intent(IN) :: name138 integer, intent(in) :: itau0139 real,intent(in) :: zjulian140 real,intent(in) :: dtime144 character*(*), INTENT(IN) :: name 145 integer, INTENT(IN) :: itau0 146 REAL,INTENT(IN) :: zjulian 147 REAL,INTENT(IN) :: dtime 141 148 integer,intent(out) :: nhori 142 149 integer,intent(out) :: nid_day … … 152 159 !$OMP END MASTER 153 160 154 end subroutinehistbeg_phy155 156 subroutinehistbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &161 END SUBROUTINE histbeg_phy 162 163 SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, & 157 164 plon,plat,plon_bounds,plat_bounds, & 158 165 nname,itau0,zjulian,dtime,nnhori,nnid_day) … … 162 169 use ioipsl 163 170 use write_field 164 implicit none171 IMPLICIT NONE 165 172 include 'dimensions.h' 166 173 167 real,dimension(klon),intent(in) :: rlon168 real,dimension(klon),intent(in) :: rlat169 integer, intent(in) :: itau0170 real,intent(in) :: zjulian171 real,intent(in) :: dtime172 integer, intent(in) :: pim174 REAL,DIMENSION(klon),INTENT(IN) :: rlon 175 REAL,DIMENSION(klon),INTENT(IN) :: rlat 176 integer, INTENT(IN) :: itau0 177 REAL,INTENT(IN) :: zjulian 178 REAL,INTENT(IN) :: dtime 179 integer, INTENT(IN) :: pim 173 180 integer, intent(out) :: nnhori 174 character(len=20), intent(in) :: nname181 character(len=20), INTENT(IN) :: nname 175 182 INTEGER, intent(out) :: nnid_day 176 183 integer :: i 177 REAL, dimension(klon_glo) :: rlat_glo178 REAL, dimension(klon_glo) :: rlon_glo179 INTEGER, DIMENSION(pim), intent(in) :: tabij180 REAL, dimension(pim), intent(in) :: plat, plon181 INTEGER, dimension(pim), intent(in) :: ipt, jpt182 REAL, dimension(pim,2), intent(out) :: plat_bounds, plon_bounds184 REAL,DIMENSION(klon_glo) :: rlat_glo 185 REAL,DIMENSION(klon_glo) :: rlon_glo 186 INTEGER, DIMENSION(pim), INTENT(IN) :: tabij 187 REAL,DIMENSION(pim), INTENT(IN) :: plat, plon 188 INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt 189 REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds 183 190 184 191 INTEGER, SAVE :: tabprocbeg, tabprocend … … 187 194 INTEGER, PARAMETER :: nip=1 188 195 INTEGER :: npproc 189 REAL, allocatable, dimension(:) :: npplat, npplon190 REAL, allocatable, dimension(:,:) :: npplat_bounds, npplon_bounds196 REAL, allocatable, DIMENSION(:) :: npplat, npplon 197 REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds 191 198 INTEGER, PARAMETER :: jjmp1=jjm+1-1/jjm 192 REAL, dimension(iim,jjmp1) :: zx_lon, zx_lat199 REAL, DIMENSION(iim,jjmp1) :: zx_lon, zx_lat 193 200 194 201 CALL gather(rlat,rlat_glo) … … 323 330 !$OMP END MASTER 324 331 325 end subroutinehistbeg_phy_points332 end SUBROUTINE histbeg_phy_points 326 333 327 334 SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field) … … 334 341 include 'iniprint.h' 335 342 336 integer, intent(in) :: nid337 logical, intent(in) :: lpoint338 character*(*), intent(IN) :: name339 integer, intent(in) :: itau340 real,dimension(:),intent(in) :: field341 REAL, dimension(klon_mpi) :: buffer_omp342 INTEGER, allocatable, dimension(:) :: index2d343 integer,INTENT(IN) :: nid 344 logical,INTENT(IN) :: lpoint 345 character*(*), INTENT(IN) :: name 346 integer, INTENT(IN) :: itau 347 REAL,DIMENSION(:),INTENT(IN) :: field 348 REAL,DIMENSION(klon_mpi) :: buffer_omp 349 INTEGER, allocatable, DIMENSION(:) :: index2d 343 350 REAL :: Field2d(iim,jj_nb) 344 351 345 352 integer :: ip 346 real,allocatable,dimension(:) :: fieldok347 348 349 IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimensionnot equal to klon',1)353 REAL,allocatable,DIMENSION(:) :: fieldok 354 355 356 IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first DIMENSION not equal to klon',1) 350 357 351 358 CALL Gather_omp(field,buffer_omp) … … 387 394 388 395 389 end subroutinehistwrite2d_phy_old390 391 subroutinehistwrite3d_phy_old(nid,lpoint,name,itau,field)396 end SUBROUTINE histwrite2d_phy_old 397 398 SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field) 392 399 USE dimphy 393 400 USE mod_phys_lmdz_para … … 395 402 396 403 use ioipsl 397 implicit none404 IMPLICIT NONE 398 405 include 'dimensions.h' 399 406 include 'iniprint.h' 400 407 401 integer, intent(in) :: nid402 logical, intent(in) :: lpoint403 character*(*), intent(IN) :: name404 integer, intent(in) :: itau405 real,dimension(:,:),intent(in) :: field ! --> field(klon,:)406 REAL, dimension(klon_mpi,size(field,2)) :: buffer_omp408 integer,INTENT(IN) :: nid 409 logical,INTENT(IN) :: lpoint 410 character*(*), INTENT(IN) :: name 411 integer, INTENT(IN) :: itau 412 REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:) 413 REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp 407 414 REAL :: Field3d(iim,jj_nb,size(field,2)) 408 415 INTEGER :: ip, n, nlev 409 INTEGER, ALLOCATABLE, dimension(:) :: index3d410 real,allocatable, dimension(:,:) :: fieldok411 412 413 IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimensionnot equal to klon',1)416 INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d 417 REAL,allocatable, DIMENSION(:,:) :: fieldok 418 419 420 IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) 414 421 nlev=size(field,2) 415 422 … … 460 467 !$OMP END MASTER 461 468 462 end subroutinehistwrite3d_phy_old469 end SUBROUTINE histwrite3d_phy_old 463 470 464 471 … … 480 487 include 'dimensions.h' 481 488 482 ! integer, intent(in) :: nid483 ! logical, intent(in) :: lpoint484 ! character*(*), intent(IN) :: name485 ! integer, intent(in) :: itau486 ! real,dimension(:),intent(in) :: field489 ! integer,INTENT(IN) :: nid 490 ! logical,INTENT(IN) :: lpoint 491 ! character*(*), INTENT(IN) :: name 492 ! integer, INTENT(IN) :: itau 493 ! REAL,DIMENSION(:),INTENT(IN) :: field 487 494 488 495 TYPE(ctrl_out), INTENT(IN) :: var … … 492 499 INTEGER :: iff, iff_beg, iff_end 493 500 494 REAL, dimension(klon_mpi) :: buffer_omp495 INTEGER, allocatable, dimension(:) :: index2d501 REAL,DIMENSION(klon_mpi) :: buffer_omp 502 INTEGER, allocatable, DIMENSION(:) :: index2d 496 503 REAL :: Field2d(iim,jj_nb) 497 504 … … 508 515 END IF 509 516 510 IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimensionnot equal to klon',1)517 IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first DIMENSION not equal to klon',1) 511 518 512 519 CALL Gather_omp(field,buffer_omp) … … 578 585 include 'dimensions.h' 579 586 580 ! integer, intent(in) :: nid581 ! logical, intent(in) :: lpoint582 ! character*(*), intent(IN) :: name583 ! integer, intent(in) :: itau584 ! real,dimension(:,:),intent(in) :: field ! --> field(klon,:)587 ! integer,INTENT(IN) :: nid 588 ! logical,INTENT(IN) :: lpoint 589 ! character*(*), INTENT(IN) :: name 590 ! integer, INTENT(IN) :: itau 591 ! REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:) 585 592 586 593 TYPE(ctrl_out), INTENT(IN) :: var … … 594 601 REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok 595 602 596 IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimensionnot equal to klon',1)603 IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) 597 604 nlev=size(field,2) 598 605
Note: See TracChangeset
for help on using the changeset viewer.