[879] | 1 | ! |
---|
| 2 | ! $Header$ |
---|
| 3 | ! |
---|
[1807] | 4 | MODULE iophy |
---|
| 5 | |
---|
| 6 | USE phys_output_var_mod |
---|
| 7 | |
---|
[1797] | 8 | ! abd REAL,private,allocatable,DIMENSION(:),save :: io_lat |
---|
| 9 | ! abd REAL,private,allocatable,DIMENSION(:),save :: io_lon |
---|
[1791] | 10 | REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat |
---|
| 11 | REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon |
---|
| 12 | INTEGER, SAVE :: phys_domain_id |
---|
| 13 | INTEGER, SAVE :: npstn |
---|
| 14 | INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij |
---|
| 15 | INTEGER, SAVE :: itau_iophy |
---|
| 16 | |
---|
| 17 | !$OMP THREADPRIVATE(itau_iophy) |
---|
[629] | 18 | |
---|
| 19 | INTERFACE histwrite_phy |
---|
[1791] | 20 | MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old |
---|
[1001] | 21 | END INTERFACE |
---|
[629] | 22 | |
---|
[1539] | 23 | INTERFACE histbeg_phy_all |
---|
| 24 | MODULE PROCEDURE histbeg_phy,histbeg_phy_points |
---|
| 25 | END INTERFACE |
---|
[1001] | 26 | |
---|
[1539] | 27 | |
---|
[1797] | 28 | CONTAINS |
---|
[629] | 29 | |
---|
[1797] | 30 | ! ug Routine pour définir itau_iophy depuis phys_output_write_mod: |
---|
| 31 | SUBROUTINE set_itau_iophy(ito) |
---|
| 32 | IMPLICIT NONE |
---|
| 33 | INTEGER, INTENT(IN) :: ito |
---|
| 34 | itau_iophy = ito |
---|
| 35 | END SUBROUTINE |
---|
| 36 | |
---|
| 37 | SUBROUTINE init_iophy_new(rlat,rlon) |
---|
[1001] | 38 | USE dimphy |
---|
| 39 | USE mod_phys_lmdz_para |
---|
| 40 | USE mod_grid_phy_lmdz |
---|
| 41 | USE ioipsl |
---|
[1797] | 42 | IMPLICIT NONE |
---|
| 43 | INCLUDE 'dimensions.h' |
---|
| 44 | REAL,DIMENSION(klon),INTENT(IN) :: rlon |
---|
| 45 | REAL,DIMENSION(klon),INTENT(IN) :: rlat |
---|
[1001] | 46 | |
---|
[1797] | 47 | REAL,DIMENSION(klon_glo) :: rlat_glo |
---|
| 48 | REAL,DIMENSION(klon_glo) :: rlon_glo |
---|
[1001] | 49 | |
---|
| 50 | INTEGER,DIMENSION(2) :: ddid |
---|
| 51 | INTEGER,DIMENSION(2) :: dsg |
---|
| 52 | INTEGER,DIMENSION(2) :: dsl |
---|
| 53 | INTEGER,DIMENSION(2) :: dpf |
---|
| 54 | INTEGER,DIMENSION(2) :: dpl |
---|
| 55 | INTEGER,DIMENSION(2) :: dhs |
---|
| 56 | INTEGER,DIMENSION(2) :: dhe |
---|
| 57 | INTEGER :: i |
---|
| 58 | |
---|
| 59 | CALL gather(rlat,rlat_glo) |
---|
| 60 | CALL bcast(rlat_glo) |
---|
| 61 | CALL gather(rlon,rlon_glo) |
---|
| 62 | CALL bcast(rlon_glo) |
---|
| 63 | |
---|
| 64 | !$OMP MASTER |
---|
[1674] | 65 | ALLOCATE(io_lat(jjm+1-1/(iim*jjm))) |
---|
[1001] | 66 | io_lat(1)=rlat_glo(1) |
---|
[1674] | 67 | io_lat(jjm+1-1/(iim*jjm))=rlat_glo(klon_glo) |
---|
| 68 | IF ((iim*jjm) > 1) then |
---|
[1001] | 69 | DO i=2,jjm |
---|
| 70 | io_lat(i)=rlat_glo(2+(i-2)*iim) |
---|
| 71 | ENDDO |
---|
| 72 | ENDIF |
---|
| 73 | |
---|
| 74 | ALLOCATE(io_lon(iim)) |
---|
[1674] | 75 | io_lon(:)=rlon_glo(2-1/(iim*jjm):iim+1-1/(iim*jjm)) |
---|
[1001] | 76 | |
---|
| 77 | ddid=(/ 1,2 /) |
---|
[1674] | 78 | dsg=(/ iim, jjm+1-1/(iim*jjm) /) |
---|
[1001] | 79 | dsl=(/ iim, jj_nb /) |
---|
| 80 | dpf=(/ 1,jj_begin /) |
---|
| 81 | dpl=(/ iim, jj_end /) |
---|
| 82 | dhs=(/ ii_begin-1,0 /) |
---|
[1797] | 83 | IF (mpi_rank==mpi_size-1) THEN |
---|
[1001] | 84 | dhe=(/0,0/) |
---|
[1797] | 85 | ELSE |
---|
[1001] | 86 | dhe=(/ iim-ii_end,0 /) |
---|
[1797] | 87 | ENDIF |
---|
[1001] | 88 | |
---|
[1797] | 89 | CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & |
---|
[1001] | 90 | 'APPLE',phys_domain_id) |
---|
| 91 | |
---|
| 92 | !$OMP END MASTER |
---|
| 93 | |
---|
[1797] | 94 | END SUBROUTINE init_iophy_new |
---|
[1001] | 95 | |
---|
[1797] | 96 | SUBROUTINE init_iophy(lat,lon) |
---|
[776] | 97 | USE dimphy |
---|
| 98 | USE mod_phys_lmdz_para |
---|
[1797] | 99 | USE ioipsl |
---|
| 100 | IMPLICIT NONE |
---|
| 101 | INCLUDE 'dimensions.h' |
---|
| 102 | REAL,DIMENSION(iim),INTENT(IN) :: lon |
---|
| 103 | REAL,DIMENSION(jjm+1-1/(iim*jjm)),INTENT(IN) :: lat |
---|
[766] | 104 | |
---|
| 105 | INTEGER,DIMENSION(2) :: ddid |
---|
| 106 | INTEGER,DIMENSION(2) :: dsg |
---|
| 107 | INTEGER,DIMENSION(2) :: dsl |
---|
| 108 | INTEGER,DIMENSION(2) :: dpf |
---|
| 109 | INTEGER,DIMENSION(2) :: dpl |
---|
| 110 | INTEGER,DIMENSION(2) :: dhs |
---|
| 111 | INTEGER,DIMENSION(2) :: dhe |
---|
| 112 | |
---|
| 113 | !$OMP MASTER |
---|
[1674] | 114 | allocate(io_lat(jjm+1-1/(iim*jjm))) |
---|
[629] | 115 | io_lat(:)=lat(:) |
---|
| 116 | allocate(io_lon(iim)) |
---|
| 117 | io_lon(:)=lon(:) |
---|
[1331] | 118 | |
---|
[766] | 119 | ddid=(/ 1,2 /) |
---|
[1674] | 120 | dsg=(/ iim, jjm+1-1/(iim*jjm) /) |
---|
[776] | 121 | dsl=(/ iim, jj_nb /) |
---|
| 122 | dpf=(/ 1,jj_begin /) |
---|
| 123 | dpl=(/ iim, jj_end /) |
---|
| 124 | dhs=(/ ii_begin-1,0 /) |
---|
| 125 | if (mpi_rank==mpi_size-1) then |
---|
[766] | 126 | dhe=(/0,0/) |
---|
| 127 | else |
---|
[776] | 128 | dhe=(/ iim-ii_end,0 /) |
---|
[766] | 129 | endif |
---|
| 130 | |
---|
[776] | 131 | call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & |
---|
[766] | 132 | 'APPLE',phys_domain_id) |
---|
[629] | 133 | |
---|
[766] | 134 | !$OMP END MASTER |
---|
| 135 | |
---|
[1797] | 136 | end SUBROUTINE init_iophy |
---|
[629] | 137 | |
---|
[1797] | 138 | SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day) |
---|
[776] | 139 | USE dimphy |
---|
| 140 | USE mod_phys_lmdz_para |
---|
[629] | 141 | use ioipsl |
---|
| 142 | use write_field |
---|
[1797] | 143 | IMPLICIT NONE |
---|
[793] | 144 | include 'dimensions.h' |
---|
[629] | 145 | |
---|
[1797] | 146 | character*(*), INTENT(IN) :: name |
---|
| 147 | integer, INTENT(IN) :: itau0 |
---|
| 148 | REAL,INTENT(IN) :: zjulian |
---|
| 149 | REAL,INTENT(IN) :: dtime |
---|
[629] | 150 | integer,intent(out) :: nhori |
---|
| 151 | integer,intent(out) :: nid_day |
---|
[766] | 152 | |
---|
| 153 | !$OMP MASTER |
---|
[776] | 154 | if (is_sequential) then |
---|
| 155 | call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), & |
---|
| 156 | 1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day) |
---|
[629] | 157 | else |
---|
[776] | 158 | call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), & |
---|
| 159 | 1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id) |
---|
[629] | 160 | endif |
---|
[766] | 161 | !$OMP END MASTER |
---|
[629] | 162 | |
---|
[1797] | 163 | END SUBROUTINE histbeg_phy |
---|
[1539] | 164 | |
---|
[1797] | 165 | SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, & |
---|
[1539] | 166 | plon,plat,plon_bounds,plat_bounds, & |
---|
| 167 | nname,itau0,zjulian,dtime,nnhori,nnid_day) |
---|
[776] | 168 | USE dimphy |
---|
| 169 | USE mod_phys_lmdz_para |
---|
[1539] | 170 | USE mod_grid_phy_lmdz |
---|
| 171 | use ioipsl |
---|
| 172 | use write_field |
---|
[1797] | 173 | IMPLICIT NONE |
---|
[1539] | 174 | include 'dimensions.h' |
---|
| 175 | |
---|
[1797] | 176 | REAL,DIMENSION(klon),INTENT(IN) :: rlon |
---|
| 177 | REAL,DIMENSION(klon),INTENT(IN) :: rlat |
---|
| 178 | integer, INTENT(IN) :: itau0 |
---|
| 179 | REAL,INTENT(IN) :: zjulian |
---|
| 180 | REAL,INTENT(IN) :: dtime |
---|
| 181 | integer, INTENT(IN) :: pim |
---|
[1539] | 182 | integer, intent(out) :: nnhori |
---|
[1797] | 183 | character(len=20), INTENT(IN) :: nname |
---|
[1539] | 184 | INTEGER, intent(out) :: nnid_day |
---|
| 185 | integer :: i |
---|
[1797] | 186 | REAL,DIMENSION(klon_glo) :: rlat_glo |
---|
| 187 | REAL,DIMENSION(klon_glo) :: rlon_glo |
---|
| 188 | INTEGER, DIMENSION(pim), INTENT(IN) :: tabij |
---|
| 189 | REAL,DIMENSION(pim), INTENT(IN) :: plat, plon |
---|
| 190 | INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt |
---|
| 191 | REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds |
---|
[1539] | 192 | |
---|
| 193 | INTEGER, SAVE :: tabprocbeg, tabprocend |
---|
| 194 | !$OMP THREADPRIVATE(tabprocbeg, tabprocend) |
---|
| 195 | INTEGER :: ip |
---|
| 196 | INTEGER, PARAMETER :: nip=1 |
---|
| 197 | INTEGER :: npproc |
---|
[1797] | 198 | REAL, allocatable, DIMENSION(:) :: npplat, npplon |
---|
| 199 | REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds |
---|
[1539] | 200 | INTEGER, PARAMETER :: jjmp1=jjm+1-1/jjm |
---|
[1797] | 201 | REAL, DIMENSION(iim,jjmp1) :: zx_lon, zx_lat |
---|
[1539] | 202 | |
---|
| 203 | CALL gather(rlat,rlat_glo) |
---|
| 204 | CALL bcast(rlat_glo) |
---|
| 205 | CALL gather(rlon,rlon_glo) |
---|
| 206 | CALL bcast(rlon_glo) |
---|
| 207 | |
---|
| 208 | !$OMP MASTER |
---|
| 209 | DO i=1,pim |
---|
| 210 | |
---|
| 211 | ! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i) |
---|
| 212 | |
---|
| 213 | plon_bounds(i,1)=rlon_glo(tabij(i)-1) |
---|
| 214 | plon_bounds(i,2)=rlon_glo(tabij(i)+1) |
---|
| 215 | if(plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN |
---|
| 216 | if(rlon_glo(tabij(i)).GE.0.) THEN |
---|
| 217 | plon_bounds(i,2)=-1*plon_bounds(i,2) |
---|
| 218 | endif |
---|
| 219 | endif |
---|
| 220 | if(plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN |
---|
| 221 | if(rlon_glo(tabij(i)).LE.0.) THEN |
---|
| 222 | plon_bounds(i,2)=-1*plon_bounds(i,2) |
---|
| 223 | endif |
---|
| 224 | endif |
---|
| 225 | ! |
---|
| 226 | IF ( tabij(i).LE.iim) THEN |
---|
| 227 | plat_bounds(i,1)=rlat_glo(tabij(i)) |
---|
| 228 | ELSE |
---|
| 229 | plat_bounds(i,1)=rlat_glo(tabij(i)-iim) |
---|
| 230 | ENDIF |
---|
| 231 | plat_bounds(i,2)=rlat_glo(tabij(i)+iim) |
---|
| 232 | ! |
---|
| 233 | ! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon_glo(tabij(i)),plon_bounds(i,2) |
---|
| 234 | ! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat_glo(tabij(i)),plat_bounds(i,2) |
---|
| 235 | ! |
---|
| 236 | ENDDO |
---|
| 237 | if (is_sequential) then |
---|
| 238 | |
---|
| 239 | npstn=pim |
---|
| 240 | IF(.NOT. ALLOCATED(nptabij)) THEN |
---|
| 241 | ALLOCATE(nptabij(pim)) |
---|
| 242 | ENDIF |
---|
| 243 | DO i=1,pim |
---|
| 244 | nptabij(i)=tabij(i) |
---|
| 245 | ENDDO |
---|
| 246 | |
---|
| 247 | CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon_glo,zx_lon) |
---|
[1674] | 248 | if ((iim*jjm).gt.1) then |
---|
[1539] | 249 | DO i = 1, iim |
---|
| 250 | zx_lon(i,1) = rlon_glo(i+1) |
---|
| 251 | zx_lon(i,jjmp1) = rlon_glo(i+1) |
---|
| 252 | ENDDO |
---|
| 253 | endif |
---|
| 254 | CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat_glo,zx_lat) |
---|
| 255 | |
---|
| 256 | DO i=1,pim |
---|
| 257 | ! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i) |
---|
| 258 | |
---|
| 259 | plon_bounds(i,1)=zx_lon(ipt(i)-1,jpt(i)) |
---|
| 260 | plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i)) |
---|
| 261 | |
---|
| 262 | if (ipt(i).EQ.1) then |
---|
| 263 | plon_bounds(i,1)=zx_lon(iim,jpt(i)) |
---|
| 264 | plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i)) |
---|
| 265 | endif |
---|
| 266 | |
---|
| 267 | if (ipt(i).EQ.iim) then |
---|
| 268 | plon_bounds(i,2)=360.+zx_lon(1,jpt(i)) |
---|
| 269 | endif |
---|
| 270 | |
---|
| 271 | plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1) |
---|
| 272 | plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1) |
---|
| 273 | |
---|
| 274 | if (jpt(i).EQ.1) then |
---|
| 275 | plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001 |
---|
| 276 | plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001 |
---|
| 277 | endif |
---|
| 278 | |
---|
| 279 | if (jpt(i).EQ.jjmp1) then |
---|
| 280 | plat_bounds(i,1)=zx_lat(ipt(i),jjmp1)+0.001 |
---|
| 281 | plat_bounds(i,2)=zx_lat(ipt(i),jjmp1)-0.001 |
---|
| 282 | endif |
---|
| 283 | ! |
---|
| 284 | ! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2) |
---|
| 285 | ! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat(tabij(i)),plat_bounds(i,2) |
---|
| 286 | ! |
---|
| 287 | ENDDO |
---|
| 288 | ! print*,'iophy is_sequential nname, nnhori, nnid_day=',trim(nname),nnhori,nnid_day |
---|
| 289 | call histbeg(nname,pim,plon,plon_bounds, & |
---|
| 290 | plat,plat_bounds, & |
---|
| 291 | itau0, zjulian, dtime, nnhori, nnid_day) |
---|
| 292 | else |
---|
| 293 | npproc=0 |
---|
| 294 | DO ip=1, pim |
---|
| 295 | tabprocbeg=klon_mpi_begin |
---|
| 296 | tabprocend=klon_mpi_end |
---|
| 297 | IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN |
---|
| 298 | npproc=npproc+1 |
---|
| 299 | npstn=npproc |
---|
| 300 | ENDIF |
---|
| 301 | ENDDO |
---|
| 302 | ! print*,'CFMIP_iophy mpi_rank npstn',mpi_rank,npstn |
---|
| 303 | IF(.NOT. ALLOCATED(nptabij)) THEN |
---|
| 304 | ALLOCATE(nptabij(npstn)) |
---|
| 305 | ALLOCATE(npplon(npstn), npplat(npstn)) |
---|
| 306 | ALLOCATE(npplon_bounds(npstn,2), npplat_bounds(npstn,2)) |
---|
| 307 | ENDIF |
---|
| 308 | npproc=0 |
---|
| 309 | DO ip=1, pim |
---|
| 310 | IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN |
---|
| 311 | npproc=npproc+1 |
---|
| 312 | nptabij(npproc)=tabij(ip) |
---|
| 313 | ! print*,'mpi_rank npproc ip plon plat tabij=',mpi_rank,npproc,ip, & |
---|
| 314 | ! plon(ip),plat(ip),tabij(ip) |
---|
| 315 | npplon(npproc)=plon(ip) |
---|
| 316 | npplat(npproc)=plat(ip) |
---|
| 317 | npplon_bounds(npproc,1)=plon_bounds(ip,1) |
---|
| 318 | npplon_bounds(npproc,2)=plon_bounds(ip,2) |
---|
| 319 | npplat_bounds(npproc,1)=plat_bounds(ip,1) |
---|
| 320 | npplat_bounds(npproc,2)=plat_bounds(ip,2) |
---|
| 321 | !!! |
---|
| 322 | !!! print qui sert a reordonner les points stations selon l'ordre CFMIP |
---|
| 323 | !!! ne pas enlever |
---|
| 324 | print*,'iophy_mpi rank ip lon lat',mpi_rank,ip,plon(ip),plat(ip) |
---|
| 325 | !!! |
---|
| 326 | ENDIF |
---|
| 327 | ENDDO |
---|
| 328 | call histbeg(nname,npstn,npplon,npplon_bounds, & |
---|
| 329 | npplat,npplat_bounds, & |
---|
| 330 | itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id) |
---|
| 331 | endif |
---|
| 332 | !$OMP END MASTER |
---|
| 333 | |
---|
[1797] | 334 | end SUBROUTINE histbeg_phy_points |
---|
[1807] | 335 | |
---|
| 336 | |
---|
| 337 | SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar) |
---|
| 338 | |
---|
| 339 | USE ioipsl |
---|
| 340 | USE dimphy |
---|
| 341 | USE mod_phys_lmdz_para |
---|
| 342 | |
---|
| 343 | IMPLICIT NONE |
---|
| 344 | |
---|
| 345 | INCLUDE "dimensions.h" |
---|
| 346 | INCLUDE "temps.h" |
---|
| 347 | INCLUDE "clesphys.h" |
---|
| 348 | |
---|
| 349 | INTEGER :: iff |
---|
| 350 | LOGICAL :: lpoint |
---|
| 351 | INTEGER, DIMENSION(nfiles) :: flag_var |
---|
| 352 | CHARACTER(LEN=20) :: nomvar |
---|
| 353 | CHARACTER(LEN=*) :: titrevar |
---|
| 354 | CHARACTER(LEN=*) :: unitvar |
---|
| 355 | |
---|
| 356 | REAL zstophym |
---|
| 357 | |
---|
| 358 | IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN |
---|
| 359 | zstophym=zoutm(iff) |
---|
| 360 | ELSE |
---|
| 361 | zstophym=zdtime_moy |
---|
| 362 | ENDIF |
---|
| 363 | |
---|
| 364 | ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
---|
| 365 | CALL conf_physoutputs(nomvar,flag_var) |
---|
| 366 | |
---|
| 367 | IF(.NOT.lpoint) THEN |
---|
| 368 | IF ( flag_var(iff)<=lev_files(iff) ) THEN |
---|
| 369 | CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, & |
---|
| 370 | iim,jj_nb,nhorim(iff), 1,1,1, -99, 32, & |
---|
| 371 | type_ecri(iff), zstophym,zoutm(iff)) |
---|
| 372 | ENDIF |
---|
| 373 | ELSE |
---|
| 374 | IF ( flag_var(iff)<=lev_files(iff) ) THEN |
---|
| 375 | CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, & |
---|
| 376 | npstn,1,nhorim(iff), 1,1,1, -99, 32, & |
---|
| 377 | type_ecri(iff), zstophym,zoutm(iff)) |
---|
| 378 | ENDIF |
---|
| 379 | ENDIF |
---|
| 380 | |
---|
| 381 | ! Set swaero_diag=true if at least one of the concerned variables are defined |
---|
| 382 | IF (nomvar=='topswad' .OR. nomvar=='topswai' .OR. nomvar=='solswad' .OR. nomvar=='solswai' ) THEN |
---|
| 383 | IF ( flag_var(iff)<=lev_files(iff) ) THEN |
---|
| 384 | swaero_diag=.TRUE. |
---|
| 385 | END IF |
---|
| 386 | END IF |
---|
| 387 | END SUBROUTINE histdef2d_old |
---|
| 388 | |
---|
| 389 | |
---|
| 390 | |
---|
| 391 | SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar) |
---|
| 392 | |
---|
| 393 | USE ioipsl |
---|
| 394 | USE dimphy |
---|
| 395 | USE mod_phys_lmdz_para |
---|
| 396 | |
---|
| 397 | IMPLICIT NONE |
---|
| 398 | |
---|
| 399 | INCLUDE "dimensions.h" |
---|
| 400 | INCLUDE "temps.h" |
---|
| 401 | ! INCLUDE "indicesol.h" |
---|
| 402 | INCLUDE "clesphys.h" |
---|
| 403 | |
---|
| 404 | INTEGER :: iff |
---|
| 405 | LOGICAL :: lpoint |
---|
| 406 | INTEGER, DIMENSION(nfiles) :: flag_var |
---|
| 407 | CHARACTER(LEN=20) :: nomvar |
---|
| 408 | CHARACTER(LEN=*) :: titrevar |
---|
| 409 | CHARACTER(LEN=*) :: unitvar |
---|
| 410 | |
---|
| 411 | REAL zstophym |
---|
| 412 | |
---|
| 413 | ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
---|
| 414 | CALL conf_physoutputs(nomvar,flag_var) |
---|
| 415 | |
---|
| 416 | IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN |
---|
| 417 | zstophym=zoutm(iff) |
---|
| 418 | ELSE |
---|
| 419 | zstophym=zdtime_moy |
---|
| 420 | ENDIF |
---|
| 421 | |
---|
| 422 | IF(.NOT.lpoint) THEN |
---|
| 423 | IF ( flag_var(iff)<=lev_files(iff) ) THEN |
---|
| 424 | CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, & |
---|
| 425 | iim, jj_nb, nhorim(iff), klev, levmin(iff), & |
---|
| 426 | levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), & |
---|
| 427 | zstophym, zoutm(iff)) |
---|
| 428 | ENDIF |
---|
| 429 | ELSE |
---|
| 430 | IF ( flag_var(iff)<=lev_files(iff) ) THEN |
---|
| 431 | CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, & |
---|
| 432 | npstn,1,nhorim(iff), klev, levmin(iff), & |
---|
| 433 | levmax(iff)-levmin(iff)+1, nvertm(iff), 32, & |
---|
| 434 | type_ecri(iff), zstophym,zoutm(iff)) |
---|
| 435 | ENDIF |
---|
| 436 | ENDIF |
---|
| 437 | END SUBROUTINE histdef3d_old |
---|
| 438 | |
---|
| 439 | |
---|
| 440 | |
---|
| 441 | |
---|
| 442 | |
---|
| 443 | |
---|
| 444 | |
---|
| 445 | |
---|
| 446 | SUBROUTINE histdef2d (iff,var) |
---|
| 447 | |
---|
| 448 | USE ioipsl |
---|
| 449 | USE dimphy |
---|
| 450 | USE mod_phys_lmdz_para |
---|
| 451 | |
---|
| 452 | IMPLICIT NONE |
---|
| 453 | |
---|
| 454 | INCLUDE "dimensions.h" |
---|
| 455 | INCLUDE "temps.h" |
---|
| 456 | INCLUDE "clesphys.h" |
---|
| 457 | |
---|
| 458 | INTEGER :: iff |
---|
| 459 | TYPE(ctrl_out) :: var |
---|
| 460 | |
---|
| 461 | REAL zstophym |
---|
| 462 | CHARACTER(LEN=20) :: typeecrit |
---|
| 463 | |
---|
| 464 | |
---|
| 465 | ! ug On récupère le type écrit de la structure: |
---|
| 466 | ! Assez moche, à refaire si meilleure méthode... |
---|
| 467 | IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN |
---|
| 468 | typeecrit = 'once' |
---|
| 469 | ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN |
---|
| 470 | typeecrit = 't_min(X)' |
---|
| 471 | ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN |
---|
| 472 | typeecrit = 't_max(X)' |
---|
| 473 | ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN |
---|
| 474 | typeecrit = 'inst(X)' |
---|
| 475 | ELSE |
---|
| 476 | typeecrit = type_ecri_files(iff) |
---|
| 477 | ENDIF |
---|
| 478 | |
---|
| 479 | IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN |
---|
| 480 | zstophym=zoutm(iff) |
---|
| 481 | ELSE |
---|
| 482 | zstophym=zdtime_moy |
---|
| 483 | ENDIF |
---|
| 484 | |
---|
| 485 | ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
---|
| 486 | CALL conf_physoutputs(var%name, var%flag) |
---|
| 487 | |
---|
| 488 | IF(.NOT.clef_stations(iff)) THEN |
---|
| 489 | IF ( var%flag(iff)<=lev_files(iff) ) THEN |
---|
| 490 | CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
---|
| 491 | iim,jj_nb,nhorim(iff), 1,1,1, -99, 32, & |
---|
| 492 | typeecrit, zstophym,zoutm(iff)) |
---|
| 493 | ENDIF |
---|
| 494 | ELSE |
---|
| 495 | IF ( var%flag(iff)<=lev_files(iff)) THEN |
---|
| 496 | CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
---|
| 497 | npstn,1,nhorim(iff), 1,1,1, -99, 32, & |
---|
| 498 | typeecrit, zstophym,zoutm(iff)) |
---|
| 499 | ENDIF |
---|
| 500 | ENDIF |
---|
| 501 | |
---|
| 502 | ! Set swaero_diag=true if at least one of the concerned variables are defined |
---|
| 503 | IF (var%name=='topswad' .OR. var%name=='topswai' .OR. var%name=='solswad' .OR. var%name=='solswai' ) THEN |
---|
| 504 | IF ( var%flag(iff)<=lev_files(iff) ) THEN |
---|
| 505 | swaero_diag=.TRUE. |
---|
| 506 | END IF |
---|
| 507 | END IF |
---|
| 508 | END SUBROUTINE histdef2d |
---|
| 509 | SUBROUTINE histdef3d (iff,var) |
---|
| 510 | |
---|
| 511 | USE ioipsl |
---|
| 512 | USE dimphy |
---|
| 513 | USE mod_phys_lmdz_para |
---|
| 514 | |
---|
| 515 | IMPLICIT NONE |
---|
| 516 | |
---|
| 517 | INCLUDE "dimensions.h" |
---|
| 518 | INCLUDE "temps.h" |
---|
| 519 | INCLUDE "clesphys.h" |
---|
| 520 | |
---|
| 521 | INTEGER :: iff |
---|
| 522 | TYPE(ctrl_out) :: var |
---|
| 523 | |
---|
| 524 | REAL zstophym |
---|
| 525 | CHARACTER(LEN=20) :: typeecrit |
---|
| 526 | |
---|
| 527 | ! ug On récupère le type écrit de la structure: |
---|
| 528 | ! Assez moche, à refaire si meilleure méthode... |
---|
| 529 | IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN |
---|
| 530 | typeecrit = 'once' |
---|
| 531 | ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN |
---|
| 532 | typeecrit = 't_min(X)' |
---|
| 533 | ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN |
---|
| 534 | typeecrit = 't_max(X)' |
---|
| 535 | ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN |
---|
| 536 | typeecrit = 'inst(X)' |
---|
| 537 | ELSE |
---|
| 538 | typeecrit = type_ecri_files(iff) |
---|
| 539 | ENDIF |
---|
| 540 | |
---|
| 541 | |
---|
| 542 | ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
---|
| 543 | CALL conf_physoutputs(var%name,var%flag) |
---|
| 544 | |
---|
| 545 | IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN |
---|
| 546 | zstophym=zoutm(iff) |
---|
| 547 | ELSE |
---|
| 548 | zstophym=zdtime_moy |
---|
| 549 | ENDIF |
---|
| 550 | |
---|
| 551 | IF(.NOT.clef_stations(iff)) THEN |
---|
| 552 | IF ( var%flag(iff)<=lev_files(iff) ) THEN |
---|
| 553 | CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
---|
| 554 | iim, jj_nb, nhorim(iff), klev, levmin(iff), & |
---|
| 555 | levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, & |
---|
| 556 | zstophym, zoutm(iff)) |
---|
| 557 | ENDIF |
---|
| 558 | ELSE |
---|
| 559 | IF ( var%flag(iff)<=lev_files(iff)) THEN |
---|
| 560 | CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
---|
| 561 | npstn,1,nhorim(iff), klev, levmin(iff), & |
---|
| 562 | levmax(iff)-levmin(iff)+1, nvertm(iff), 32, & |
---|
| 563 | typeecrit, zstophym,zoutm(iff)) |
---|
| 564 | ENDIF |
---|
| 565 | ENDIF |
---|
| 566 | END SUBROUTINE histdef3d |
---|
| 567 | |
---|
| 568 | SUBROUTINE conf_physoutputs(nam_var,flag_var) |
---|
| 569 | !!! Lecture des noms et niveau de sortie des variables dans output.def |
---|
| 570 | ! en utilisant les routines getin de IOIPSL |
---|
| 571 | use ioipsl |
---|
| 572 | |
---|
| 573 | IMPLICIT NONE |
---|
| 574 | |
---|
| 575 | include 'iniprint.h' |
---|
| 576 | |
---|
| 577 | CHARACTER(LEN=20) :: nam_var |
---|
| 578 | INTEGER, DIMENSION(nfiles) :: flag_var |
---|
| 579 | |
---|
| 580 | IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:) |
---|
| 581 | CALL getin('flag_'//nam_var,flag_var) |
---|
| 582 | CALL getin('name_'//nam_var,nam_var) |
---|
| 583 | IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:) |
---|
| 584 | |
---|
| 585 | END SUBROUTINE conf_physoutputs |
---|
| 586 | |
---|
| 587 | |
---|
[1539] | 588 | |
---|
[1791] | 589 | SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field) |
---|
[1539] | 590 | USE dimphy |
---|
| 591 | USE mod_phys_lmdz_para |
---|
[776] | 592 | USE ioipsl |
---|
[1791] | 593 | IMPLICIT NONE |
---|
[793] | 594 | include 'dimensions.h' |
---|
[1775] | 595 | include 'iniprint.h' |
---|
[629] | 596 | |
---|
[1797] | 597 | integer,INTENT(IN) :: nid |
---|
| 598 | logical,INTENT(IN) :: lpoint |
---|
| 599 | character*(*), INTENT(IN) :: name |
---|
| 600 | integer, INTENT(IN) :: itau |
---|
| 601 | REAL,DIMENSION(:),INTENT(IN) :: field |
---|
| 602 | REAL,DIMENSION(klon_mpi) :: buffer_omp |
---|
| 603 | INTEGER, allocatable, DIMENSION(:) :: index2d |
---|
[1331] | 604 | REAL :: Field2d(iim,jj_nb) |
---|
| 605 | |
---|
[1539] | 606 | integer :: ip |
---|
[1797] | 607 | REAL,allocatable,DIMENSION(:) :: fieldok |
---|
[1539] | 608 | |
---|
[1791] | 609 | |
---|
[1797] | 610 | IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first DIMENSION not equal to klon',1) |
---|
[776] | 611 | |
---|
| 612 | CALL Gather_omp(field,buffer_omp) |
---|
[766] | 613 | !$OMP MASTER |
---|
[1331] | 614 | CALL grid1Dto2D_mpi(buffer_omp,Field2d) |
---|
[1539] | 615 | if(.NOT.lpoint) THEN |
---|
| 616 | ALLOCATE(index2d(iim*jj_nb)) |
---|
| 617 | ALLOCATE(fieldok(iim*jj_nb)) |
---|
[1775] | 618 | IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL' |
---|
[1539] | 619 | CALL histwrite(nid,name,itau,Field2d,iim*jj_nb,index2d) |
---|
[1775] | 620 | IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
---|
[1539] | 621 | else |
---|
| 622 | ALLOCATE(fieldok(npstn)) |
---|
| 623 | ALLOCATE(index2d(npstn)) |
---|
| 624 | |
---|
| 625 | if(is_sequential) then |
---|
| 626 | ! klon_mpi_begin=1 |
---|
| 627 | ! klon_mpi_end=klon |
---|
| 628 | DO ip=1, npstn |
---|
| 629 | fieldok(ip)=buffer_omp(nptabij(ip)) |
---|
| 630 | ENDDO |
---|
| 631 | else |
---|
| 632 | DO ip=1, npstn |
---|
| 633 | ! print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip) |
---|
| 634 | IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
---|
| 635 | nptabij(ip).LE.klon_mpi_end) THEN |
---|
| 636 | fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1) |
---|
| 637 | ENDIF |
---|
| 638 | ENDDO |
---|
| 639 | endif |
---|
[1775] | 640 | IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL' |
---|
[1539] | 641 | CALL histwrite(nid,name,itau,fieldok,npstn,index2d) |
---|
[1775] | 642 | IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
---|
[1539] | 643 | ! |
---|
| 644 | endif |
---|
| 645 | deallocate(index2d) |
---|
| 646 | deallocate(fieldok) |
---|
[1791] | 647 | !$OMP END MASTER |
---|
[1331] | 648 | |
---|
[1791] | 649 | |
---|
[1797] | 650 | end SUBROUTINE histwrite2d_phy_old |
---|
[1791] | 651 | |
---|
[1797] | 652 | SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field) |
---|
[776] | 653 | USE dimphy |
---|
| 654 | USE mod_phys_lmdz_para |
---|
| 655 | |
---|
[629] | 656 | use ioipsl |
---|
[1797] | 657 | IMPLICIT NONE |
---|
[793] | 658 | include 'dimensions.h' |
---|
[1775] | 659 | include 'iniprint.h' |
---|
[629] | 660 | |
---|
[1797] | 661 | integer,INTENT(IN) :: nid |
---|
| 662 | logical,INTENT(IN) :: lpoint |
---|
| 663 | character*(*), INTENT(IN) :: name |
---|
| 664 | integer, INTENT(IN) :: itau |
---|
| 665 | REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:) |
---|
| 666 | REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp |
---|
[1331] | 667 | REAL :: Field3d(iim,jj_nb,size(field,2)) |
---|
[1539] | 668 | INTEGER :: ip, n, nlev |
---|
[1797] | 669 | INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d |
---|
| 670 | REAL,allocatable, DIMENSION(:,:) :: fieldok |
---|
[1539] | 671 | |
---|
[1791] | 672 | |
---|
[1797] | 673 | IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) |
---|
[1331] | 674 | nlev=size(field,2) |
---|
[1539] | 675 | |
---|
| 676 | ! print*,'hist3d_phy mpi_rank npstn=',mpi_rank,npstn |
---|
| 677 | |
---|
| 678 | ! DO ip=1, npstn |
---|
| 679 | ! print*,'hist3d_phy mpi_rank nptabij',mpi_rank,nptabij(ip) |
---|
| 680 | ! ENDDO |
---|
| 681 | |
---|
[776] | 682 | CALL Gather_omp(field,buffer_omp) |
---|
[766] | 683 | !$OMP MASTER |
---|
[1331] | 684 | CALL grid1Dto2D_mpi(buffer_omp,field3d) |
---|
[1539] | 685 | if(.NOT.lpoint) THEN |
---|
| 686 | ALLOCATE(index3d(iim*jj_nb*nlev)) |
---|
| 687 | ALLOCATE(fieldok(iim*jj_nb,nlev)) |
---|
[1775] | 688 | IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL' |
---|
[1539] | 689 | CALL histwrite(nid,name,itau,Field3d,iim*jj_nb*nlev,index3d) |
---|
[1775] | 690 | IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
---|
| 691 | else |
---|
[1539] | 692 | nlev=size(field,2) |
---|
| 693 | ALLOCATE(index3d(npstn*nlev)) |
---|
| 694 | ALLOCATE(fieldok(npstn,nlev)) |
---|
| 695 | |
---|
| 696 | if(is_sequential) then |
---|
| 697 | ! klon_mpi_begin=1 |
---|
| 698 | ! klon_mpi_end=klon |
---|
| 699 | DO n=1, nlev |
---|
| 700 | DO ip=1, npstn |
---|
| 701 | fieldok(ip,n)=buffer_omp(nptabij(ip),n) |
---|
| 702 | ENDDO |
---|
| 703 | ENDDO |
---|
| 704 | else |
---|
| 705 | DO n=1, nlev |
---|
| 706 | DO ip=1, npstn |
---|
| 707 | IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
---|
| 708 | nptabij(ip).LE.klon_mpi_end) THEN |
---|
| 709 | fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n) |
---|
| 710 | ENDIF |
---|
| 711 | ENDDO |
---|
| 712 | ENDDO |
---|
| 713 | endif |
---|
[1775] | 714 | IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL' |
---|
[1539] | 715 | CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d) |
---|
[1775] | 716 | IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
---|
[1539] | 717 | endif |
---|
| 718 | deallocate(index3d) |
---|
| 719 | deallocate(fieldok) |
---|
[766] | 720 | !$OMP END MASTER |
---|
[1791] | 721 | |
---|
[1797] | 722 | end SUBROUTINE histwrite3d_phy_old |
---|
[1791] | 723 | |
---|
| 724 | |
---|
[1807] | 725 | |
---|
| 726 | |
---|
[1791] | 727 | ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE |
---|
| 728 | SUBROUTINE histwrite2d_phy(var,field, STD_iff) |
---|
| 729 | USE dimphy |
---|
| 730 | USE mod_phys_lmdz_para |
---|
| 731 | USE ioipsl |
---|
[629] | 732 | |
---|
[1791] | 733 | |
---|
[1807] | 734 | |
---|
[1791] | 735 | #ifdef CPP_XIOS |
---|
| 736 | ! USE WXIOS |
---|
| 737 | #endif |
---|
| 738 | |
---|
| 739 | IMPLICIT NONE |
---|
[1807] | 740 | INCLUDE 'dimensions.h' |
---|
| 741 | INCLUDE 'iniprint.h' |
---|
[1791] | 742 | |
---|
[1807] | 743 | TYPE(ctrl_out), INTENT(IN) :: var |
---|
| 744 | REAL, DIMENSION(:), INTENT(IN) :: field |
---|
| 745 | INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS..... |
---|
[1791] | 746 | |
---|
[1807] | 747 | INTEGER :: iff, iff_beg, iff_end |
---|
[1791] | 748 | |
---|
[1797] | 749 | REAL,DIMENSION(klon_mpi) :: buffer_omp |
---|
| 750 | INTEGER, allocatable, DIMENSION(:) :: index2d |
---|
[1791] | 751 | REAL :: Field2d(iim,jj_nb) |
---|
| 752 | |
---|
| 753 | INTEGER :: ip |
---|
| 754 | REAL, ALLOCATABLE, DIMENSION(:) :: fieldok |
---|
| 755 | |
---|
[1807] | 756 | IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name |
---|
| 757 | |
---|
[1791] | 758 | ! ug RUSTINE POUR LES STD LEVS..... |
---|
| 759 | IF (PRESENT(STD_iff)) THEN |
---|
| 760 | iff_beg = STD_iff |
---|
| 761 | iff_end = STD_iff |
---|
| 762 | ELSE |
---|
| 763 | iff_beg = 1 |
---|
| 764 | iff_end = nfiles |
---|
| 765 | END IF |
---|
| 766 | |
---|
[1807] | 767 | ! On regarde si on est dans la phase de définition ou d'écriture: |
---|
| 768 | IF(.NOT.vars_defined) THEN |
---|
| 769 | |
---|
| 770 | !Si phase de définition.... on définit |
---|
| 771 | DO iff=iff_beg, iff_end |
---|
| 772 | IF (clef_files(iff)) THEN |
---|
| 773 | CALL histdef2d(iff, var) |
---|
| 774 | ENDIF |
---|
| 775 | ENDDO |
---|
| 776 | ELSE |
---|
| 777 | |
---|
| 778 | !Et sinon on.... écrit |
---|
| 779 | IF (SIZE(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first DIMENSION not equal to klon',1) |
---|
[1791] | 780 | |
---|
| 781 | CALL Gather_omp(field,buffer_omp) |
---|
| 782 | !$OMP MASTER |
---|
| 783 | CALL grid1Dto2D_mpi(buffer_omp,Field2d) |
---|
| 784 | |
---|
| 785 | ! La boucle sur les fichiers: |
---|
| 786 | DO iff=iff_beg, iff_end |
---|
| 787 | IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN |
---|
| 788 | |
---|
| 789 | IF(.NOT.clef_stations(iff)) THEN |
---|
| 790 | ALLOCATE(index2d(iim*jj_nb)) |
---|
| 791 | ALLOCATE(fieldok(iim*jj_nb)) |
---|
| 792 | |
---|
| 793 | CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,iim*jj_nb,index2d) |
---|
| 794 | #ifdef CPP_XIOS |
---|
| 795 | ! IF (iff .EQ. 1) THEN |
---|
| 796 | ! CALL wxios_write_2D(var%name, Field2d) |
---|
| 797 | ! ENDIF |
---|
| 798 | #endif |
---|
| 799 | ELSE |
---|
| 800 | ALLOCATE(fieldok(npstn)) |
---|
| 801 | ALLOCATE(index2d(npstn)) |
---|
| 802 | |
---|
| 803 | IF (is_sequential) THEN |
---|
| 804 | DO ip=1, npstn |
---|
| 805 | fieldok(ip)=buffer_omp(nptabij(ip)) |
---|
| 806 | ENDDO |
---|
| 807 | ELSE |
---|
| 808 | DO ip=1, npstn |
---|
[1807] | 809 | PRINT*,'histwrite2d is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip) |
---|
[1791] | 810 | IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
---|
| 811 | nptabij(ip).LE.klon_mpi_end) THEN |
---|
| 812 | fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1) |
---|
| 813 | ENDIF |
---|
| 814 | ENDDO |
---|
| 815 | ENDIF |
---|
| 816 | |
---|
| 817 | CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d) |
---|
| 818 | ENDIF |
---|
| 819 | |
---|
| 820 | deallocate(index2d) |
---|
| 821 | deallocate(fieldok) |
---|
| 822 | ENDIF !levfiles |
---|
| 823 | ENDDO |
---|
| 824 | !$OMP END MASTER |
---|
[1807] | 825 | ENDIF ! vars_defined |
---|
| 826 | IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d ',var%name |
---|
[1791] | 827 | END SUBROUTINE histwrite2d_phy |
---|
| 828 | |
---|
| 829 | |
---|
| 830 | ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE |
---|
[1807] | 831 | SUBROUTINE histwrite3d_phy(var, field, STD_iff) |
---|
[1791] | 832 | USE dimphy |
---|
| 833 | USE mod_phys_lmdz_para |
---|
[1807] | 834 | USE ioipsl |
---|
[1791] | 835 | |
---|
| 836 | |
---|
| 837 | #ifdef CPP_XIOS |
---|
| 838 | ! USE WXIOS |
---|
| 839 | #endif |
---|
| 840 | |
---|
| 841 | |
---|
| 842 | IMPLICIT NONE |
---|
[1807] | 843 | INCLUDE 'dimensions.h' |
---|
| 844 | INCLUDE 'iniprint.h' |
---|
[1791] | 845 | |
---|
[1807] | 846 | TYPE(ctrl_out), INTENT(IN) :: var |
---|
| 847 | REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:) |
---|
| 848 | INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS..... |
---|
| 849 | |
---|
| 850 | INTEGER :: iff |
---|
[1791] | 851 | |
---|
| 852 | REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp |
---|
| 853 | REAL :: Field3d(iim,jj_nb,SIZE(field,2)) |
---|
[1807] | 854 | INTEGER :: ip, n, nlev |
---|
[1791] | 855 | INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d |
---|
| 856 | REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok |
---|
| 857 | |
---|
[1807] | 858 | IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name |
---|
[1791] | 859 | |
---|
[1807] | 860 | ! On regarde si on est dans la phase de définition ou d'écriture: |
---|
| 861 | IF(.NOT.vars_defined) THEN |
---|
| 862 | !Si phase de définition.... on définit |
---|
| 863 | DO iff=1, nfiles |
---|
| 864 | IF (clef_files(iff)) THEN |
---|
| 865 | CALL histdef3d(iff, var) |
---|
| 866 | ENDIF |
---|
| 867 | ENDDO |
---|
| 868 | ELSE |
---|
| 869 | !Et sinon on.... écrit |
---|
| 870 | IF (SIZE(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) |
---|
| 871 | nlev=SIZE(field,2) |
---|
[1791] | 872 | |
---|
| 873 | |
---|
| 874 | CALL Gather_omp(field,buffer_omp) |
---|
| 875 | !$OMP MASTER |
---|
| 876 | CALL grid1Dto2D_mpi(buffer_omp,field3d) |
---|
| 877 | |
---|
| 878 | |
---|
| 879 | ! BOUCLE SUR LES FICHIERS |
---|
| 880 | DO iff=1, nfiles |
---|
| 881 | IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN |
---|
| 882 | IF (.NOT.clef_stations(iff)) THEN |
---|
| 883 | ALLOCATE(index3d(iim*jj_nb*nlev)) |
---|
| 884 | ALLOCATE(fieldok(iim*jj_nb,nlev)) |
---|
| 885 | CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,iim*jj_nb*nlev,index3d) |
---|
| 886 | #ifdef CPP_XIOS |
---|
| 887 | ! IF (iff .EQ. 1) THEN |
---|
| 888 | ! CALL wxios_write_3D(var%name, Field3d(:,:,1:klev)) |
---|
| 889 | ! ENDIF |
---|
| 890 | #endif |
---|
| 891 | |
---|
| 892 | ELSE |
---|
| 893 | nlev=size(field,2) |
---|
| 894 | ALLOCATE(index3d(npstn*nlev)) |
---|
| 895 | ALLOCATE(fieldok(npstn,nlev)) |
---|
| 896 | |
---|
| 897 | IF (is_sequential) THEN |
---|
| 898 | DO n=1, nlev |
---|
| 899 | DO ip=1, npstn |
---|
| 900 | fieldok(ip,n)=buffer_omp(nptabij(ip),n) |
---|
| 901 | ENDDO |
---|
| 902 | ENDDO |
---|
| 903 | ELSE |
---|
| 904 | DO n=1, nlev |
---|
| 905 | DO ip=1, npstn |
---|
| 906 | IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
---|
| 907 | nptabij(ip).LE.klon_mpi_end) THEN |
---|
| 908 | fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n) |
---|
| 909 | ENDIF |
---|
| 910 | ENDDO |
---|
| 911 | ENDDO |
---|
| 912 | ENDIF |
---|
| 913 | CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d) |
---|
| 914 | ENDIF |
---|
| 915 | deallocate(index3d) |
---|
| 916 | deallocate(fieldok) |
---|
| 917 | ENDIF |
---|
| 918 | ENDDO |
---|
| 919 | !$OMP END MASTER |
---|
[1807] | 920 | ENDIF ! vars_defined |
---|
| 921 | IF (prt_level >= 9) write(lunout,*)'End histrwrite3d ',var%name |
---|
[1791] | 922 | END SUBROUTINE histwrite3d_phy |
---|
| 923 | |
---|
[629] | 924 | end module iophy |
---|