- Timestamp:
- 2019-12-10T15:44:23+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DIA/diawri.F90
r11536 r12154 26 26 !!---------------------------------------------------------------------- 27 27 USE oce ! ocean dynamics and tracers 28 USE abl ! abl variables in case ln_abl = .true. 28 29 USE dom_oce ! ocean space and time domain 29 30 USE phycst ! physical constants … … 66 67 PUBLIC dia_wri_state 67 68 PUBLIC dia_wri_alloc ! Called by nemogcm module 68 69 #if ! defined key_iomput 70 PUBLIC dia_wri_alloc_abl ! Called by sbcabl module (if ln_abl = .true.) 71 #endif 69 72 INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file 70 73 INTEGER :: nb_T , ndim_bT ! grid_T file … … 72 75 INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file 73 76 INTEGER :: nid_W, nz_W, nh_W ! grid_W file 77 INTEGER :: nid_A, nz_A, nh_A, ndim_A, ndim_hA ! grid_ABL file 74 78 INTEGER :: ndex(1) ! ??? 75 79 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 80 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 76 81 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 77 82 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT … … 414 419 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 415 420 ! 416 421 dia_wri_alloc = MAXVAL(ierr) 417 422 CALL mpp_sum( 'diawri', dia_wri_alloc ) 418 423 ! 419 424 END FUNCTION dia_wri_alloc 420 421 425 426 INTEGER FUNCTION dia_wri_alloc_abl() 427 !!---------------------------------------------------------------------- 428 ALLOCATE( ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 429 CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 430 ! 431 END FUNCTION dia_wri_alloc_abl 432 422 433 SUBROUTINE dia_wri( kt ) 423 434 !!--------------------------------------------------------------------- … … 440 451 INTEGER :: ierr ! error code return from allocation 441 452 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 453 INTEGER :: ipka ! ABL 442 454 INTEGER :: jn, ierror ! local integers 443 455 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars … … 445 457 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 446 458 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 459 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 447 460 !!---------------------------------------------------------------------- 448 461 ! … … 478 491 ijmi = 1 ; ijma = jpj 479 492 ipk = jpk 493 IF(ln_abl) ipka = jpkam1 480 494 481 495 ! define time axis … … 580 594 & "m", ipk, gdepw_1d, nz_W, "down" ) 581 595 596 IF( ln_abl ) THEN 597 ! Define the ABL grid FILE ( nid_A ) 598 CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 599 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 600 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 601 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 602 & nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 603 CALL histvert( nid_A, "ght_abl", "Vertical T levels", & ! Vertical grid: gdept 604 & "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 605 ! ! Index of ocean points 606 ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 607 zw3d_abl(:,:,:) = 1._wp 608 CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A ) ! volume 609 CALL wheneq( jpi*jpj , zw3d_abl, 1, 1., ndex_hA, ndim_hA ) ! surface 610 DEALLOCATE(zw3d_abl) 611 ENDIF 582 612 583 613 ! Declare all the output fields as NETCDF variables … … 629 659 CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm 630 660 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 631 ! 661 ! 662 IF( ln_abl ) THEN 663 CALL histdef( nid_A, "t_abl", "Potential Temperature" , "K" , & ! t_abl 664 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 665 CALL histdef( nid_A, "q_abl", "Humidity" , "kg/kg" , & ! q_abl 666 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 667 CALL histdef( nid_A, "u_abl", "Atmospheric U-wind " , "m/s" , & ! u_abl 668 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 669 CALL histdef( nid_A, "v_abl", "Atmospheric V-wind " , "m/s" , & ! v_abl 670 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 671 CALL histdef( nid_A, "tke_abl", "Atmospheric TKE " , "m2/s2" , & ! tke_abl 672 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 673 CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s" , & ! avm_abl 674 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 675 CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2", & ! avt_abl 676 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 677 CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height " , "m", & ! pblh 678 & jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 679 #if defined key_si3 680 CALL histdef( nid_A, "oce_frac", "Fraction of open ocean" , " ", & ! ato_i 681 & jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 682 #endif 683 CALL histend( nid_A, snc4chunks=snc4set ) 684 ENDIF 685 ! 632 686 IF( ln_icebergs ) THEN 633 687 CALL histdef( nid_T, "calving" , "calving mass input" , "kg/s" , & … … 787 841 CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction 788 842 CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed 789 ! 843 ! 844 IF( ln_abl ) THEN 845 ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 846 IF( ln_mskland ) THEN 847 DO jk=1,jpka 848 zw3d_abl(:,:,jk) = tmask(:,:,1) 849 END DO 850 ELSE 851 zw3d_abl(:,:,:) = 1._wp 852 ENDIF 853 CALL histwrite( nid_A, "pblh" , it, pblh(:,:) *zw3d_abl(:,:,1 ), ndim_hA, ndex_hA ) ! pblh 854 CALL histwrite( nid_A, "u_abl" , it, u_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! u_abl 855 CALL histwrite( nid_A, "v_abl" , it, v_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! v_abl 856 CALL histwrite( nid_A, "t_abl" , it, tq_abl (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! t_abl 857 CALL histwrite( nid_A, "q_abl" , it, tq_abl (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! q_abl 858 CALL histwrite( nid_A, "tke_abl", it, tke_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! tke_abl 859 CALL histwrite( nid_A, "avm_abl", it, avm_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avm_abl 860 CALL histwrite( nid_A, "avt_abl", it, avt_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avt_abl 861 #if defined key_si3 862 CALL histwrite( nid_A, "oce_frac" , it, ato_i(:,:) , ndim_hA, ndex_hA ) ! ato_i 863 #endif 864 DEALLOCATE(zw3d_abl) 865 ENDIF 866 ! 790 867 IF( ln_icebergs ) THEN 791 868 ! … … 857 934 CALL histclo( nid_V ) 858 935 CALL histclo( nid_W ) 936 IF(ln_abl) CALL histclo( nid_A ) 859 937 ENDIF 860 938 ! … … 926 1004 CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity 927 1005 ENDIF 1006 IF ( ln_abl ) THEN 1007 CALL iom_rstput ( 0, 0, inum, "uz1_abl", u_abl(:,:,2,nt_a ) ) ! now first level i-wind 1008 CALL iom_rstput ( 0, 0, inum, "vz1_abl", v_abl(:,:,2,nt_a ) ) ! now first level j-wind 1009 CALL iom_rstput ( 0, 0, inum, "tz1_abl", tq_abl(:,:,2,nt_a,1) ) ! now first level temperature 1010 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 1011 ENDIF 928 1012 929 1013 #if defined key_si3
Note: See TracChangeset
for help on using the changeset viewer.
