- Timestamp:
- Nov 28, 2014, 4:36:29 PM (10 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 2072,2075-2115,2117-2126,2128-2158
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/cosp/cosp_output_write_mod.F90
r1999 r2160 8 8 INTEGER, SAVE :: itau_iocosp 9 9 !$OMP THREADPRIVATE(itau_iocosp) 10 INTEGER, save :: Nlevout, Ncolout 11 !$OMP THREADPRIVATE(Nlevout, Ncolout) 10 12 11 13 ! INTERFACE histwrite_cosp … … 15 17 CONTAINS 16 18 17 SUBROUTINE cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, cfg, gbx, sglidar, stlidar, isccp) 19 SUBROUTINE cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, & 20 cfg, gbx, vgrid, sglidar, stlidar, isccp) 18 21 19 22 USE ioipsl … … 21 24 22 25 #ifdef CPP_XIOS 23 ! ug Pour les sorties XIOS24 USE wxios26 USE wxios, only: wxios_closedef 27 USE xios, only: xios_update_calendar 25 28 #endif 26 29 … … 33 36 type(cosp_isccp) :: isccp ! Output from ISCCP simulator 34 37 type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator 38 type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats 35 39 36 40 !!! Variables locales 37 integer :: icl , iinitend=141 integer :: icl 38 42 logical :: ok_sync 39 43 integer :: itau_wcosp … … 41 45 42 46 include "temps.h" 43 44 IF (MOD(itap,NINT(freq_COSP/dtime)).EQ.0) THEN 45 47 include "iniprint.h" 48 49 Nlevout = vgrid%Nlvgrid 50 Ncolout = Ncolumns 51 46 52 ! A refaire 47 53 itau_wcosp = itau_phy + itap + start_time * day_step / iphysiq 54 if (prt_level >= 10) then 55 WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step, iphysiq =', & 56 itau_wcosp, itap, start_time, day_step, iphysiq 57 endif 48 58 49 59 ! On le donne a cosp_output_write_mod pour que les histwrite y aient acces: 50 60 CALL set_itau_iocosp(itau_wcosp) 61 if (prt_level >= 10) then 62 WRITE(lunout,*)'itau_iocosp =',itau_iocosp 63 endif 51 64 52 65 ok_sync = .TRUE. 53 66 54 IF(.NOT.cosp_varsdefined) THEN 55 iinitend = 2 56 ELSE 57 iinitend = 1 58 ENDIF 59 60 ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage: 61 DO iinit=1, iinitend 62 #ifdef CPP_XIOS 67 !DO iinit=1, iinitend 68 ! AI sept 2014 cette boucle supprimee 69 ! On n'ecrit pas quand itap=1 (cosp) 70 71 if (prt_level >= 10) then 72 WRITE(lunout,*)'DO iinit=1, iinitend ',iinitend 73 endif 74 75 #ifdef CPP_XIOS 76 !$OMP MASTER 63 77 IF (cosp_varsdefined) THEN 64 CALL wxios_update_calendar(itau_iocosp) 65 END IF 78 if (prt_level >= 10) then 79 WRITE(lunout,*)'Apell xios_update_calendar cosp_varsdefined iinitend ', & 80 cosp_varsdefined,iinitend 81 endif 82 CALL xios_update_calendar(itau_wcosp) 83 ENDIF 84 !$OMP END MASTER 85 !$OMP BARRIER 66 86 #endif 67 87 68 88 if (cfg%Llidar_sim) then 69 70 89 ! Pb des valeurs indefinies, on les met a 0 71 90 ! A refaire proprement … … 109 128 enddo 110 129 130 print*,'Appel histwrite2d_cosp' 111 131 CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1)) 112 132 CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3)) … … 201 221 IF(.NOT.cosp_varsdefined) THEN 202 222 !$OMP MASTER 223 #ifndef CPP_IOIPSL_NO_OUTPUT 203 224 DO iff=1,3 204 225 IF (cosp_outfilekeys(iff)) THEN … … 206 227 ENDIF ! cosp_outfilekeys 207 228 ENDDO ! iff 208 #ifdef CPP_XIOS 229 #endif 230 ! Fermeture dans phys_output_write 231 !#ifdef CPP_XIOS 209 232 !On finalise l'initialisation: 210 CALL wxios_closedef() 211 #endif 233 !CALL wxios_closedef() 234 !#endif 235 212 236 !$OMP END MASTER 213 237 !$OMP BARRIER 214 238 cosp_varsdefined = .TRUE. 215 239 END IF 216 END DO !! iinit 217 218 ! IF(cosp_varsdefined) THEN 240 241 IF(cosp_varsdefined) THEN 219 242 ! On synchronise les fichiers pour IOIPSL 243 #ifndef CPP_IOIPSL_NO_OUTPUT 220 244 !$OMP MASTER 221 DO iff=1,3245 DO iff=1,3 222 246 IF (ok_sync .AND. cosp_outfilekeys(iff)) THEN 223 247 CALL histsync(cosp_nidfiles(iff)) 224 248 ENDIF 225 END DO249 END DO 226 250 !$OMP END MASTER 227 228 ENDIF ! if freq_COSP251 #endif 252 ENDIF !cosp_varsdefined 229 253 230 254 END SUBROUTINE cosp_output_write … … 251 275 INCLUDE "dimensions.h" 252 276 INCLUDE "temps.h" 277 INCLUDE "clesphys.h" 278 include "iniprint.h" 253 279 254 280 INTEGER :: iff … … 279 305 280 306 #ifdef CPP_XIOS 307 IF (.not. ok_all_xml) then 308 IF ( var%cles(iff) ) THEN 309 if (prt_level >= 10) then 310 WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name 311 endif 281 312 CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), & 282 var%description, var%unit, 1, typeecrit) 283 #endif 313 var%description, var%unit, 1, typeecrit) 314 ENDIF 315 ENDIF 316 #endif 317 318 #ifndef CPP_IOIPSL_NO_OUTPUT 284 319 IF ( var%cles(iff) ) THEN 285 320 CALL histdef (cosp_nidfiles(iff), var%name, var%description, var%unit, & … … 287 322 typeecrit, zstophym,zoutm_cosp(iff)) 288 323 ENDIF 324 #endif 289 325 290 326 END SUBROUTINE histdef2d_cosp … … 305 341 INCLUDE "dimensions.h" 306 342 INCLUDE "temps.h" 343 INCLUDE "clesphys.h" 344 include "iniprint.h" 307 345 308 346 INTEGER :: iff, klevs … … 315 353 CHARACTER(LEN=20) :: nom 316 354 character(len=2) :: str2 355 CHARACTER(len=20) :: nam_axvert 317 356 318 357 ! Axe vertical 319 358 IF (nvertsave.eq.nvertp(iff)) THEN 320 359 klevs=PARASOL_NREFL 360 nam_axvert="sza" 321 361 ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN 322 362 klevs=7 363 nam_axvert="pressure2" 323 364 ELSE IF (nvertsave.eq.nvertcol(iff)) THEN 324 365 klevs=Ncolout 366 nam_axvert="column" 325 367 ELSE 326 klevs=Nlevout 368 klevs=Nlevout 369 nam_axvert="presnivs" 327 370 ENDIF 328 329 371 330 372 ! ug RUSTINE POUR LES Champs 4D 331 373 IF (PRESENT(ncols)) THEN … … 358 400 359 401 #ifdef CPP_XIOS 360 CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), & 361 var%description, var%unit, 1, typeecrit) 362 #endif 402 IF (.not. ok_all_xml) then 403 IF ( var%cles(iff) ) THEN 404 if (prt_level >= 10) then 405 WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert 406 endif 407 CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), & 408 var%description, var%unit, 1, typeecrit, nam_axvert) 409 ENDIF 410 ENDIF 411 #endif 412 413 #ifndef CPP_IOIPSL_NO_OUTPUT 363 414 IF ( var%cles(iff) ) THEN 364 415 CALL histdef (cosp_nidfiles(iff), nom, var%description, var%unit, & … … 367 418 zstophym, zoutm_cosp(iff)) 368 419 ENDIF 420 #endif 421 369 422 END SUBROUTINE histdef3d_cosp 370 423 … … 376 429 377 430 #ifdef CPP_XIOS 378 USE wxios431 USE xios, only: xios_send_field 379 432 #endif 380 433 … … 382 435 INCLUDE 'dimensions.h' 383 436 INCLUDE 'iniprint.h' 437 INCLUDE 'clesphys.h' 384 438 385 439 TYPE(ctrl_outcosp), INTENT(IN) :: var … … 393 447 CHARACTER(LEN=20) :: nomi, nom 394 448 character(len=2) :: str2 449 LOGICAL, SAVE :: firstx 450 !$OMP THREADPRIVATE(firstx) 395 451 396 452 IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name … … 417 473 418 474 ! La boucle sur les fichiers: 475 firstx=.true. 419 476 DO iff=1, 3 420 477 IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN 421 478 ALLOCATE(index2d(iim*jj_nb)) 479 #ifndef CPP_IOIPSL_NO_OUTPUT 422 480 CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,iim*jj_nb,index2d) 423 #ifdef CPP_XIOS 424 IF (iff == 1) THEN 425 CALL wxios_write_2D(var%name, Field2d) 426 ENDIF 427 #endif 428 481 #endif 429 482 deallocate(index2d) 430 ENDIF !levfiles 431 ENDDO 483 #ifdef CPP_XIOS 484 IF (.not. ok_all_xml) then 485 if (firstx) then 486 if (prt_level >= 10) then 487 WRITE(lunout,*)'xios_send_field variable ',var%name 488 endif 489 CALL xios_send_field(var%name, Field2d) 490 firstx=.false. 491 endif 492 ENDIF 493 #endif 494 ENDIF 495 ENDDO 496 497 #ifdef CPP_XIOS 498 IF (ok_all_xml) THEN 499 if (prt_level >= 10) then 500 WRITE(lunout,*)'xios_send_field variable ',var%name 501 endif 502 CALL xios_send_field(var%name, Field2d) 503 ENDIF 504 #endif 505 432 506 !$OMP END MASTER 433 507 ENDIF ! vars_defined 434 IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ', nom508 IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name 435 509 END SUBROUTINE histwrite2d_cosp 436 510 … … 444 518 445 519 #ifdef CPP_XIOS 446 USE WXIOS520 USE xios, only: xios_send_field 447 521 #endif 448 522 … … 451 525 INCLUDE 'dimensions.h' 452 526 INCLUDE 'iniprint.h' 527 INCLUDE 'clesphys.h' 453 528 454 529 TYPE(ctrl_outcosp), INTENT(IN) :: var … … 465 540 CHARACTER(LEN=20) :: nomi, nom 466 541 character(len=2) :: str2 542 LOGICAL, SAVE :: firstx 543 !$OMP THREADPRIVATE(firstx) 467 544 468 545 IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name … … 498 575 CALL grid1Dto2D_mpi(buffer_omp,field3d) 499 576 500 501 577 ! BOUCLE SUR LES FICHIERS 578 firstx=.true. 502 579 DO iff=1, 3 503 580 IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN 504 581 ALLOCATE(index3d(iim*jj_nb*nlev)) 582 #ifndef CPP_IOIPSL_NO_OUTPUT 505 583 CALL histwrite(cosp_nidfiles(iff),nom,itau_iocosp,Field3d,iim*jj_nb*nlev,index3d) 506 507 #ifdef CPP_XIOS 508 IF (iff == 1) THEN 509 CALL wxios_write_3D(nom, Field3d(:,:,1:klev)) 584 #endif 585 586 #ifdef CPP_XIOS 587 IF (.not. ok_all_xml) then 588 IF (firstx) THEN 589 CALL xios_send_field(nom, Field3d(:,:,1:nlev)) 590 IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name 591 firstx=.FALSE. 510 592 ENDIF 593 ENDIF 511 594 #endif 512 595 deallocate(index3d) 513 596 ENDIF 514 597 ENDDO 598 #ifdef CPP_XIOS 599 IF (ok_all_xml) THEN 600 CALL xios_send_field(nom, Field3d(:,:,1:nlev)) 601 IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name 602 ENDIF 603 #endif 604 515 605 !$OMP END MASTER 516 606 ENDIF ! vars_defined
Note: See TracChangeset
for help on using the changeset viewer.