source: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/stratH2O_methox.F90 @ 5105

Last change on this file since 5105 was 5105, checked in by abarral, 8 weeks ago

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

File size: 5.3 KB
Line 
1
2! $Id: stratH2O_methox.F90 3677 2020-05-06 15:18:32Z oboucher $
3
4SUBROUTINE stratH2O_methox(debutphy,paprs,dq_ch4mmr)
5
6! output: CH4VMR in MMR/s (mass mixing ratio/s or kg H2O/kg air/s)
7
8  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
9                      nf95_inq_varid, nf95_inquire_dimension, nf95_open
10  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
11
12  USE mod_grid_phy_lmdz
13  USE mod_phys_lmdz_mpi_data, ONLY:  is_mpi_root
14  USE mod_phys_lmdz_omp_data, ONLY:  is_omp_root
15
16  USE mod_phys_lmdz_para
17  USE dimphy
18  USE phys_cal_mod, ONLY: mth_cur
19  USE infotrac_phy
20  USE aerophys
21  USE lmdz_yomcst
22  USE strataer_local_var_mod, ONLY: flag_newclim_file
23 
24  IMPLICIT NONE
25
26  include "dimensions.h"
27 
28! Input variables
29  REAL paprs(klon,klev+1)
30  LOGICAL, INTENT(IN) :: debutphy   ! flag for first physiq step
31! Output variables
32! tendency buffer used in add_phys_tend SUBROUTINE (in physiq_mod)
33  REAL, INTENT(INOUT), DIMENSION(klon,klev)  :: dq_ch4mmr
34 
35! Local variables
36  INTEGER n_lat   ! number of latitudes in the input data
37  INTEGER n_lon   ! number of longitudes in the input data
38  INTEGER, SAVE :: n_lev   ! number of levels in the input data
39!$OMP THREADPRIVATE(n_lev)
40  INTEGER n_mth   ! number of months in the input data
41  INTEGER, SAVE :: mth_pre
42!$OMP THREADPRIVATE(mth_pre)
43 
44! Reconstitutes fields
45  REAL paprs_glo(klon_glo,klev+1)
46 
47  REAL, ALLOCATABLE:: latitude(:)
48! (of input data sorted in strictly ascending order)
49  REAL, ALLOCATABLE:: longitude(:)
50! (of input data sorted in strictly ascending order)
51  REAL, ALLOCATABLE:: time(:)
52! (of input data sorted in strictly ascending order)
53  REAL, ALLOCATABLE:: lev(:)
54! levels of input data
55 
56! Stratospheric H2O source from CH4 oxidation from fixed climatos
57! (H2O production in VMR/sec)
58  REAL, ALLOCATABLE :: CH4RVMR_in(:, :, :, :)
59  REAL, ALLOCATABLE :: CH4RVMR_mth(:, :, :)
60  REAL, ALLOCATABLE :: CH4RVMR_tmp(:, :)
61  REAL CH4RVMR_glo(klon_glo,klev)
62
63  INTEGER i, k, kk, j
64 
65! For NetCDF:
66  INTEGER ncid_in  ! IDs for input files
67  INTEGER varid, ncerr
68   
69  INTEGER, PARAMETER :: lev_input=17
70!--pressure at interfaces of input data (in Pa)
71  REAL, DIMENSION(lev_input+1), PARAMETER ::          &
72                    paprs_input=(/                    &
73  1.00000002e+05,   6.06530673e+04,   3.67879449e+04, &
74  2.23130165e+04,   1.35335286e+04,   8.20850004e+03, &
75  4.97870695e+03,   3.01973841e+03,   1.83156393e+03, &
76  1.11089968e+03,   6.73794715e+02,   4.08677153e+02, &
77  2.47875223e+02,   1.50343923e+02,   9.11881985e+01, &
78  5.53084382e+01,   3.35462635e+01,   0.0           /)
79
80  IF (debutphy .OR. mth_cur /= mth_pre) THEN
81     
82!--preparation of global fields
83     CALL gather(paprs, paprs_glo)
84     
85     IF (is_mpi_root.AND.is_omp_root) THEN
86       
87        print *,'In stratH2O_methox read file: ch4r_annual_lmdz.nc'
88       
89        !--reading strat. H2O source (CH4 oxidation) files
90        CALL nf95_open("ch4r_annual_lmdz.nc", nf90_nowrite, ncid_in)
91       
92        CALL  nf95_inq_varid(ncid_in, "LEV", varid)
93        CALL nf95_gw_var(ncid_in, varid, lev)
94        n_lev = size(lev)
95       
96        CALL nf95_inq_varid(ncid_in, "LAT", varid)
97        CALL nf95_gw_var(ncid_in, varid, latitude)
98        n_lat = size(latitude)
99       
100        CALL nf95_inq_varid(ncid_in, "LON", varid)
101        CALL nf95_gw_var(ncid_in, varid, longitude)
102        n_lon = size(longitude)
103       
104        CALL nf95_inq_varid(ncid_in, "TIME", varid)
105        CALL nf95_gw_var(ncid_in, varid, time)
106        n_mth = size(time)
107       
108        IF (.NOT.ALLOCATED(CH4RVMR_in)) ALLOCATE(CH4RVMR_in(n_lon, n_lat, n_lev, n_mth))
109       
110        CALL nf95_inq_varid(ncid_in, "CH4RVMR", varid)
111        ncerr = nf90_get_var(ncid_in, varid, CH4RVMR_in)
112        print *,'code erreur CH4RVMR=', ncerr, varid
113       
114        CALL nf95_close(ncid_in)
115       
116        IF (.NOT.ALLOCATED(CH4RVMR_mth)) ALLOCATE(CH4RVMR_mth(n_lon, n_lat, n_lev))
117        IF (.NOT.ALLOCATED(CH4RVMR_tmp)) ALLOCATE(CH4RVMR_tmp(klon_glo, n_lev))
118       
119        !---select the correct month,
120        !---correct latitudinal order,convert input from volume mixing ratio to mass mixing ratio
121        DO j=1,n_lat
122           ! convert VMR/s in MMR/s (mass mixing ratio/s or kg H2O/kg air/s)
123           ! x2 because CH4->2*H2O
124           CH4RVMR_mth(:,j,:) = 2*CH4RVMR_in(:,n_lat+1-j,:,mth_cur)*mH2Omol/mAIRmol
125        ENDDO
126       
127        !---reduce to a klon_glo grid but keep the levels
128        CALL grid2dTo1d_glo(CH4RVMR_mth,CH4RVMR_tmp)
129       
130        !---regrid weighted climatologies
131        DO i=1, klon_glo
132           DO k=1, klev
133             
134              CH4RVMR_glo(i,k)=0.0
135             
136              DO kk=1, n_lev
137
138                 CH4RVMR_glo(i,k)=CH4RVMR_glo(i,k)+ &
139                      MAX(0.0,MIN(paprs_glo(i,k),paprs_input(kk)) &
140                      -MAX(paprs_glo(i,k+1),paprs_input(kk+1))) &
141                      *CH4RVMR_tmp(i,kk)/(paprs_glo(i,k)-paprs_glo(i,k+1))
142              ENDDO ! kk loop
143           ENDDO ! k loop
144        ENDDO ! i loop
145     ENDIF !--is_mpi_root and is_omp_root
146     
147     !--keep memory of previous month
148     mth_pre=mth_cur
149     
150     !--scatter global fields around
151     CALL scatter(CH4RVMR_glo, dq_ch4mmr)
152     
153     IF (is_mpi_root.AND.is_omp_root) THEN
154        DEALLOCATE(CH4RVMR_in,CH4RVMR_mth,CH4RVMR_tmp)
155     ENDIF !--is_mpi_root and is_omp_root
156  ENDIF ! debutphy.OR.new month
157 
158
159 
160END SUBROUTINE stratH2O_methox
Note: See TracBrowser for help on using the repository browser.