source: LMDZ6/branches/ICOLMDZISO/libf/phylmd/StratAer/stratH2O_methox.F90

!
! $Id: stratH2O_methox.F90 3677 2020-05-06 15:18:32Z oboucher $
!
SUBROUTINE stratH2O_methox(debutphy,paprs,dq_ch4mmr)
!
! output: CH4VMR in MMR/s (mass mixing ratio/s or kg H2O/kg air/s)

  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
                      nf95_inq_varid, nf95_inquire_dimension, nf95_open
  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite

  USE mod_grid_phy_lmdz
  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
  USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root

  USE mod_phys_lmdz_para 
  USE dimphy
  USE phys_cal_mod, ONLY : mth_cur
  USE infotrac_phy
  USE aerophys
  USE YOMCST
  USE strataer_local_var_mod, ONLY : flag_newclim_file
  
  IMPLICIT NONE
  
  include "dimensions.h"
  
! Input variables
  REAL paprs(klon,klev+1)
  LOGICAL, INTENT(IN) :: debutphy   ! flag for first physiq step
! Output variables
! tendency buffer used in add_phys_tend subroutine (in physiq_mod)
  REAL, INTENT(INOUT), DIMENSION(klon,klev)  :: dq_ch4mmr
  
! Local variables
  INTEGER n_lat   ! number of latitudes in the input data
  INTEGER n_lon   ! number of longitudes in the input data
  INTEGER, SAVE :: n_lev   ! number of levels in the input data
!$OMP THREADPRIVATE(n_lev)
  INTEGER n_mth   ! number of months in the input data
  INTEGER, SAVE :: mth_pre
!$OMP THREADPRIVATE(mth_pre)
  
! Reconstitutes fields
  REAL paprs_glo(klon_glo,klev+1)
  
  REAL, ALLOCATABLE:: latitude(:)
! (of input data sorted in strictly ascending order)
  REAL, ALLOCATABLE:: longitude(:)
! (of input data sorted in strictly ascending order)
  REAL, ALLOCATABLE:: time(:)
! (of input data sorted in strictly ascending order)
  REAL, ALLOCATABLE:: lev(:)
! levels of input data
  
! Stratospheric H2O source from CH4 oxidation from fixed climatos
! (H2O production in VMR/sec)
  REAL, ALLOCATABLE :: CH4RVMR_in(:, :, :, :)
  REAL, ALLOCATABLE :: CH4RVMR_mth(:, :, :)
  REAL, ALLOCATABLE :: CH4RVMR_tmp(:, :)
  REAL CH4RVMR_glo(klon_glo,klev)
!
  INTEGER i, k, kk, j
  
! For NetCDF:
  INTEGER ncid_in  ! IDs for input files
  INTEGER varid, ncerr
    
  INTEGER, PARAMETER :: lev_input=17
!--pressure at interfaces of input data (in Pa)
  REAL, DIMENSION(lev_input+1), PARAMETER ::          & 
                    paprs_input=(/                    &
  1.00000002e+05,   6.06530673e+04,   3.67879449e+04, &
  2.23130165e+04,   1.35335286e+04,   8.20850004e+03, &
  4.97870695e+03,   3.01973841e+03,   1.83156393e+03, &
  1.11089968e+03,   6.73794715e+02,   4.08677153e+02, &
  2.47875223e+02,   1.50343923e+02,   9.11881985e+01, &
  5.53084382e+01,   3.35462635e+01,   0.0           /)
!
  
  IF (debutphy .OR. mth_cur .NE. mth_pre) THEN
     
!--preparation of global fields
     CALL gather(paprs, paprs_glo)
     
     IF (is_mpi_root.AND.is_omp_root) THEN
        
        print *,'In stratH2O_methox read file: ch4r_annual_lmdz.nc'
        
        !--reading strat. H2O source (CH4 oxidation) files
        CALL nf95_open("ch4r_annual_lmdz.nc", nf90_nowrite, ncid_in)
        
        CALL  nf95_inq_varid(ncid_in, "LEV", varid)
        CALL nf95_gw_var(ncid_in, varid, lev)
        n_lev = size(lev)
        
        CALL nf95_inq_varid(ncid_in, "LAT", varid)
        CALL nf95_gw_var(ncid_in, varid, latitude)
        n_lat = size(latitude)
        
        CALL nf95_inq_varid(ncid_in, "LON", varid)
        CALL nf95_gw_var(ncid_in, varid, longitude)
        n_lon = size(longitude)
        
        CALL nf95_inq_varid(ncid_in, "TIME", varid)
        CALL nf95_gw_var(ncid_in, varid, time)
        n_mth = size(time)
        
        IF (.NOT.ALLOCATED(CH4RVMR_in)) ALLOCATE(CH4RVMR_in(n_lon, n_lat, n_lev, n_mth))
        
        CALL nf95_inq_varid(ncid_in, "CH4RVMR", varid)
        ncerr = nf90_get_var(ncid_in, varid, CH4RVMR_in)
        print *,'code erreur CH4RVMR=', ncerr, varid
        
        CALL nf95_close(ncid_in)
        
        IF (.NOT.ALLOCATED(CH4RVMR_mth)) ALLOCATE(CH4RVMR_mth(n_lon, n_lat, n_lev))
        IF (.NOT.ALLOCATED(CH4RVMR_tmp)) ALLOCATE(CH4RVMR_tmp(klon_glo, n_lev))
        
        !---select the correct month,
        !---correct latitudinal order,convert input from volume mixing ratio to mass mixing ratio
        DO j=1,n_lat
           ! convert VMR/s in MMR/s (mass mixing ratio/s or kg H2O/kg air/s)
           ! x2 because CH4->2*H2O
           CH4RVMR_mth(:,j,:) = 2*CH4RVMR_in(:,n_lat+1-j,:,mth_cur)*mH2Omol/mAIRmol
        ENDDO
        
        !---reduce to a klon_glo grid but keep the levels
        CALL grid2dTo1d_glo(CH4RVMR_mth,CH4RVMR_tmp)
        
        !---regrid weighted climatologies
        DO i=1, klon_glo
           DO k=1, klev
              
              CH4RVMR_glo(i,k)=0.0
              
              DO kk=1, n_lev
                 !
                 CH4RVMR_glo(i,k)=CH4RVMR_glo(i,k)+ &
                      MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk)) &
                      -MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
                      *CH4RVMR_tmp(i,kk)/(paprs_glo(i,k)-paprs_glo(i,k+1))
              ENDDO ! kk loop
           ENDDO ! k loop
        ENDDO ! i loop
     ENDIF !--is_mpi_root and is_omp_root
     
     !--keep memory of previous month
     mth_pre=mth_cur
     
     !--scatter global fields around
     CALL scatter(CH4RVMR_glo, dq_ch4mmr)
     
     IF (is_mpi_root.AND.is_omp_root) THEN
        DEALLOCATE(CH4RVMR_in,CH4RVMR_mth,CH4RVMR_tmp)
     ENDIF !--is_mpi_root and is_omp_root
  ENDIF ! debutphy.OR.new month
  
  RETURN
  
END SUBROUTINE stratH2O_methox