New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12182 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90 – NEMO

Ignore:
Timestamp:
2019-12-11T12:38:43+01:00 (4 years ago)
Author:
davestorkey
Message:

2019/dev_r11943_MERGE_2019: Merge in dev_ASINTER-01-05_merge.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90

    r12150 r12182  
    2828   USE isf_oce 
    2929   USE isfcpl 
     30   USE abl            ! abl variables in case ln_abl = .true. 
    3031   USE dom_oce        ! ocean space and time domain 
    3132   USE phycst         ! physical constants 
     
    6869   PUBLIC   dia_wri_state 
    6970   PUBLIC   dia_wri_alloc           ! Called by nemogcm module 
    70  
     71#if ! defined key_iomput    
     72   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.) 
     73#endif 
    7174   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    7275   INTEGER ::          nb_T              , ndim_bT   ! grid_T file 
     
    7477   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
    7578   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file 
     79   INTEGER ::   nid_A, nz_A, nh_A, ndim_A, ndim_hA   ! grid_ABL file    
    7680   INTEGER ::   ndex(1)                              ! ??? 
    7781   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
     82   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 
    7883   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 
    7984   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 
     
    417422         &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
    418423         ! 
    419       dia_wri_alloc = MAXVAL(ierr) 
     424     dia_wri_alloc = MAXVAL(ierr) 
    420425      CALL mpp_sum( 'diawri', dia_wri_alloc ) 
    421426      ! 
    422427   END FUNCTION dia_wri_alloc 
     428  
     429   INTEGER FUNCTION dia_wri_alloc_abl() 
     430      !!---------------------------------------------------------------------- 
     431     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 
     432      CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 
     433      ! 
     434   END FUNCTION dia_wri_alloc_abl 
    423435 
    424436    
     
    444456      INTEGER  ::   ierr                                     ! error code return from allocation 
    445457      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     458      INTEGER  ::   ipka                                     ! ABL 
    446459      INTEGER  ::   jn, ierror                               ! local integers 
    447460      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
     
    449462      REAL(wp), DIMENSION(jpi,jpj)   :: zw2d       ! 2D workspace 
    450463      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d       ! 3D workspace 
     464      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    451465      !!---------------------------------------------------------------------- 
    452466      ! 
     
    482496      ijmi = 1      ;      ijma = jpj 
    483497      ipk = jpk 
     498      IF(ln_abl) ipka = jpkam1 
    484499 
    485500      ! define time axis 
     
    584599            &          "m", ipk, gdepw_1d, nz_W, "down" ) 
    585600 
     601         IF( ln_abl ) THEN  
     602         ! Define the ABL grid FILE ( nid_A ) 
     603            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 
     604            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
     605            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     606               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
     607               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 
     608            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept 
     609               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 
     610            !                                                            ! Index of ocean points 
     611         ALLOCATE( zw3d_abl(jpi,jpj,ipka) )  
     612         zw3d_abl(:,:,:) = 1._wp  
     613         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume 
     614            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface 
     615         DEALLOCATE(zw3d_abl) 
     616         ENDIF 
    586617 
    587618         ! Declare all the output fields as NETCDF variables 
     
    633664         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    634665            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    635 ! 
     666         ! 
     667         IF( ln_abl ) THEN 
     668            CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl 
     669               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     670            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl 
     671               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     672            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl 
     673               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     674            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl 
     675               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     676            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl 
     677               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     678            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl 
     679               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     680            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl 
     681               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     682            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh 
     683               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                  
     684#if defined key_si3 
     685            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i 
     686               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout ) 
     687#endif 
     688            CALL histend( nid_A, snc4chunks=snc4set ) 
     689         ENDIF 
     690         ! 
    636691         IF( ln_icebergs ) THEN 
    637692            CALL histdef( nid_T, "calving"             , "calving mass input"                       , "kg/s"   , & 
     
    791846      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    792847      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
    793 ! 
     848      ! 
     849      IF( ln_abl ) THEN  
     850         ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 
     851         IF( ln_mskland )   THEN  
     852            DO jk=1,jpka 
     853               zw3d_abl(:,:,jk) = tmask(:,:,1) 
     854            END DO        
     855         ELSE 
     856            zw3d_abl(:,:,:) = 1._wp      
     857         ENDIF        
     858         CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh  
     859         CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl 
     860         CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl 
     861         CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl 
     862         CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl        
     863         CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl 
     864         CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl 
     865         CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl  
     866#if defined key_si3 
     867         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i 
     868#endif 
     869         DEALLOCATE(zw3d_abl) 
     870      ENDIF 
     871      ! 
    794872      IF( ln_icebergs ) THEN 
    795873         ! 
     
    861939         CALL histclo( nid_V ) 
    862940         CALL histclo( nid_W ) 
     941         IF(ln_abl) CALL histclo( nid_A ) 
    863942      ENDIF 
    864943      ! 
     
    883962      INTEGER           , INTENT( in ) ::   Kmm              ! time level index 
    884963      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    885       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zisfdebug 
    886964      !! 
    887965      INTEGER :: inum, jk 
     
    9551033         CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd            )    ! now StokesDrift k-velocity 
    9561034      ENDIF 
     1035      IF ( ln_abl ) THEN 
     1036         CALL iom_rstput ( 0, 0, inum, "uz1_abl",   u_abl(:,:,2,nt_a  ) )   ! now first level i-wind 
     1037         CALL iom_rstput ( 0, 0, inum, "vz1_abl",   v_abl(:,:,2,nt_a  ) )   ! now first level j-wind 
     1038         CALL iom_rstput ( 0, 0, inum, "tz1_abl",  tq_abl(:,:,2,nt_a,1) )   ! now first level temperature 
     1039         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity 
     1040      ENDIF 
    9571041  
    9581042#if defined key_si3 
Note: See TracChangeset for help on using the changeset viewer.