Changeset 1532 for trunk/LMDZ.MARS/libf/phymars/writediagfi.F
- Timestamp:
- Apr 7, 2016, 3:53:15 PM (9 years ago)
- File:
-
- 1 edited
-
trunk/LMDZ.MARS/libf/phymars/writediagfi.F (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/phymars/writediagfi.F
r1528 r1532 63 63 real*4 dx1(nbp_lev) ! to store a 1D (column) data set 64 64 real*4 dx0 65 real*4 dx3_1d(1,nbp_lev) ! to store a profile with 1D model 66 real*4 dx2_1d ! to store a surface value with 1D model 65 67 66 68 real*4,save :: date 69 !$OMP THREADPRIVATE(date) 67 70 68 71 REAL phis((nbp_lon+1),nbp_lat) … … 75 78 integer,save :: zitau=0 76 79 character(len=20),save :: firstnom='1234567890' 80 !$OMP THREADPRIVATE(zitau,firstnom) 77 81 78 82 ! Ajouts 79 83 integer, save :: ntime=0 84 !$OMP THREADPRIVATE(ntime) 80 85 integer :: idim,varid 81 86 integer :: nid … … 92 97 character(len=120),save :: nom_def(n_nom_def_max) 93 98 logical,save :: firstcall=.true. 99 !$OMP THREADPRIVATE(firstcall) !diagfi_def,n_nom_def,nom_def read in diagfi.def 94 100 95 #ifndef MESOSCALE96 97 101 #ifdef CPP_PARA 98 102 ! Added to work in parallel mode … … 127 131 firstcall=.false. 128 132 133 !$OMP MASTER 129 134 ! Open diagfi.def definition file if there is one: 130 135 open(99,file="diagfi.def",status='old',form='formatted', … … 150 155 diagfi_def=.false. 151 156 endif 157 !$OMP END MASTER 158 !$OMP BARRIER 152 159 END IF ! of IF (firstcall) 153 160 … … 214 221 215 222 ! Build phis() and area() 216 do i=1,nbp_lon+1 ! poles 223 IF (klon_glo>1) THEN 224 do i=1,nbp_lon+1 ! poles 217 225 phis(i,1)=phisfi_glo(1) 218 226 phis(i,nbp_lat)=phisfi_glo(klon_glo) … … 220 228 area(i,1)=areafi_glo(1)/nbp_lon 221 229 area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon 222 enddo223 do j=2,nbp_lat-1230 enddo 231 do j=2,nbp_lat-1 224 232 ig0= 1+(j-2)*nbp_lon 225 233 do i=1,nbp_lon … … 230 238 phis(nbp_lon+1,j)=phis(1,j) 231 239 area(nbp_lon+1,j)=area(1,j) 232 enddo 240 enddo 241 ENDIF 233 242 234 243 ! write "header" of file (longitudes, latitudes, geopotential, ...) 235 call iniwrite(nid,day_ini,phis,area) 244 IF (klon_glo>1) THEN ! general 3D case 245 call iniwrite(nid,day_ini,phis,area,nbp_lon+1,nbp_lat) 246 ELSE ! 1D model 247 call iniwrite(nid,day_ini,phisfi_glo(1),areafi_glo(1),1,1) 248 ENDIF 236 249 237 250 endif ! of if (is_master) … … 248 261 endif ! if (firstnom.eq.'1234567890') 249 262 250 if ( ngrid.eq.1) then263 if (klon_glo.eq.1) then 251 264 ! in testphys1d, for the 1d version of the GCM, iphysiq and irythme 252 265 ! are undefined; so set them to 1 253 266 iphysiq=1 254 267 irythme=1 255 ! NB:256 268 endif 257 269 … … 320 332 ! Passage variable physique --> variable dynamique 321 333 ! recast (copy) variable from physics grid to dynamics grid 334 IF (klon_glo>1) THEN ! General case 322 335 DO l=1,nbp_lev 323 336 DO i=1,nbp_lon+1 … … 333 346 ENDDO 334 347 ENDDO 348 ELSE ! 1D model case 349 dx3_1d(1,1:nbp_lev)=px(1,1:nbp_lev) 350 ENDIF 335 351 #endif 336 352 ! Ecriture du champs … … 360 376 corner(4)=ntime 361 377 362 edges(1)=nbp_lon+1 378 IF (klon_glo==1) THEN 379 edges(1)=1 380 ELSE 381 edges(1)=nbp_lon+1 382 ENDIF 363 383 edges(2)=nbp_lat 364 384 edges(3)=nbp_lev … … 371 391 ! write(*,*)" edges()=",edges 372 392 ! write(*,*)" dx3()=",dx3 373 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3) 393 IF (klon_glo>1) THEN ! General case 394 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3) 395 ELSE 396 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3_1d) 397 ENDIF 374 398 !#endif 375 399 376 400 if (ierr.ne.NF_NOERR) then 377 401 write(*,*) "***** PUT_VAR problem in writediagfi" 378 write(*,*) "***** with ",nom402 write(*,*) "***** with dx3: ",nom 379 403 write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr) 380 c call abort 404 stop 381 405 endif 382 406 … … 405 429 ! Passage variable physique --> physique dynamique 406 430 ! recast (copy) variable from physics grid to dynamics grid 407 431 IF (klon_glo>1) THEN ! General case 408 432 DO i=1,nbp_lon+1 409 433 dx2(i,1)=px(1,1) … … 417 441 dx2(nbp_lon+1,j)=dx2(1,j) 418 442 ENDDO 443 ELSE ! 1D model case 444 dx2_1d=px(1,1) 445 ENDIF 419 446 #endif 420 447 … … 442 469 corner(2)=1 443 470 corner(3)=ntime 444 edges(1)=nbp_lon+1 471 IF (klon_glo==1) THEN 472 edges(1)=1 473 ELSE 474 edges(1)=nbp_lon+1 475 ENDIF 445 476 edges(2)=nbp_lat 446 477 edges(3)=1 … … 450 481 ! ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) 451 482 !#else 452 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2) 483 IF (klon_glo>1) THEN ! General case 484 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2) 485 ELSE 486 ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2_1d) 487 ENDIF 453 488 !#endif 454 489 455 490 if (ierr.ne.NF_NOERR) then 456 491 write(*,*) "***** PUT_VAR matter in writediagfi" 457 write(*,*) "***** with ",nom492 write(*,*) "***** with dx2: ",nom 458 493 write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr) 459 c call abort 494 stop 460 495 endif 461 496 … … 505 540 if (ierr.ne.NF_NOERR) then 506 541 write(*,*) "***** PUT_VAR problem in writediagfi" 507 write(*,*) "***** with ",nom542 write(*,*) "***** with dx1: ",nom 508 543 write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr) 509 c call abort 544 stop 510 545 endif 511 546 … … 543 578 if (ierr.ne.NF_NOERR) then 544 579 write(*,*) "***** PUT_VAR matter in writediagfi" 545 write(*,*) "***** with ",nom580 write(*,*) "***** with dx0: ",nom 546 581 write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr) 547 c call abort 582 stop 548 583 endif 549 584 … … 558 593 endif 559 594 560 #endif561 595 end
Note: See TracChangeset
for help on using the changeset viewer.
