libf/dyn3d/startdyn.f90

MODULE startdyn

  ! From startvar.F, version 1.4
  ! 2006/01/27 15:14:22 Fairhead

  IMPLICIT NONE

  private
  public start_init_dyn, start_inter_3d

  INTEGER fid_dyn, iml_dyn, jml_dyn, llm_dyn, ttm_dyn

  REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)
  ! (longitude and latitude from the input file, converted to rad)

  real, ALLOCATABLE:: levdyn_ini(:)

CONTAINS

  SUBROUTINE start_init_dyn(tsol_2d, psol)

    ! Host associated variables appearing and modified in this procedure :
    ! iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn, lon_ini, lat_ini, levdyn_ini

    USE ioipsl, only: flininfo, flinopen_nozoom, flinget
    use comgeom, only: aire_2d, apoln, apols
    use conf_dat2d_m, only: conf_dat2d
    use inter_barxy_m, only: inter_barxy
    use comconst, only: pi
    use comgeom, only: rlonu, rlatv
    use dimens_m, only: iim, jjm
    use gr_int_dyn_m, only: gr_int_dyn
    use start_init_orog_m, only: phis
    use start_init_phys_m, only: start_init_phys

    REAL, intent(out):: tsol_2d(:, :)
    REAL, intent(out):: psol(:, :) ! surface pressure, in Pa

    ! Local:

    REAL date, dt
    INTEGER itau(1)
    INTEGER i, j

    CHARACTER(len=120) physfname

    REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)

    REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)
    ! (longitude and latitude from the input file, in rad or degrees)

    REAL, ALLOCATABLE:: var_ana(:, :), z(:, :)
    real tmp_var(iim, jjm + 1)
    REAL, ALLOCATABLE:: xppn(:), xpps(:)

    !--------------------------

    print *, "Call sequence information: start_init_dyn"
    if (any((/size(tsol_2d, 1), size(psol, 1)/) /= iim + 1)) stop &
         "start_init_phys size 1"
    if (any((/size(tsol_2d, 2), size(psol, 2)/) /= jjm + 1)) stop &
         "start_init_phys size 2"
    physfname = 'ECDYN.nc'
    print *, 'Opening the surface analysis'
    CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
    print *, 'Values read from "' // trim(physfname) // '":'
    print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
         ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn

    ALLOCATE(lat_dyn(iml_dyn, jml_dyn))
    ALLOCATE(lon_dyn(iml_dyn, jml_dyn))
    ALLOCATE(levdyn_ini(llm_dyn))

    CALL flinopen_nozoom(physfname, iml_dyn, jml_dyn, llm_dyn, &
         lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)

    ALLOCATE(var_ana(iml_dyn, jml_dyn))
    ALLOCATE(lon_rad(iml_dyn))
    ALLOCATE(lon_ini(iml_dyn))

    IF (MAXVAL(lon_dyn(:, :)) > pi) THEN
       ! Assume "lon_dyn" is in degrees 
       lon_ini(:) = lon_dyn(:, 1) * pi / 180.
    ELSE
       lon_ini(:) = lon_dyn(:, 1) 
    ENDIF

    ALLOCATE(lat_rad(jml_dyn))
    ALLOCATE(lat_ini(jml_dyn))

    IF (MAXVAL(lat_dyn(:, :)) > pi) THEN
       lat_ini(:) = lat_dyn(1, :) * pi / 180.
    ELSE
       lat_ini(:) = lat_dyn(1, :) 
    ENDIF

    ALLOCATE(z(iim + 1, jjm + 1))

    ! 'Z': Surface geopotential
    CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
    CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
    CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
         rlatv, tmp_var)
    z(:, :) = gr_int_dyn(tmp_var)

    ! 'SP': Surface pressure
    CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
    CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
    CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
         rlatv, tmp_var) 
    psol(:, :) = gr_int_dyn(tmp_var)
    CALL start_init_phys(tsol_2d)

    ! PSOL is computed in Pascals

    DO j = 1, jjm + 1
       DO i = 1, iim
          psol(i, j) = psol(i, j) &
               * (1. + (z(i, j) - phis(i, j)) / 287. / tsol_2d(i, j))
       ENDDO
    ENDDO
    psol(iim + 1, :) = psol(1, :)

    ALLOCATE(xppn(iim))
    ALLOCATE(xpps(iim)) 

    DO  i = 1, iim
       xppn(i) = aire_2d( i, 1) * psol( i, 1)
       xpps(i) = aire_2d( i, jjm + 1) * psol( i, jjm + 1)
    ENDDO

    psol(:, 1) = SUM(xppn)/apoln
    psol(:, jjm + 1) = SUM(xpps)/apols

  END SUBROUTINE start_init_dyn

  !********************************

  function start_inter_3d(varname, lon_in2, lat_in2, pls_in)

    ! This procedure gets a 3D variable from a file and does the
    ! interpolations needed.

    USE ioipsl, only: flinget
    use nrutil, only: assert_eq

    use inter_barxy_m, only: inter_barxy
    use interpolation, only: spline, splint
    use gr_int_dyn_m, only: gr_int_dyn
    use conf_dat3d_m, only: conf_dat3d

    CHARACTER(len=*), intent(in):: varname
    REAL, intent(in):: lon_in2(:), lat_in2(:)
    REAL, intent(in):: pls_in(:, :, :)

    REAL start_inter_3d(size(lon_in2), size(pls_in, 2), size(pls_in, 3))

    ! LOCAL:
    INTEGER iml, jml, lml
    INTEGER ii, ij, il
    REAL lon_rad(iml_dyn), lat_rad(jml_dyn)
    REAL lev_dyn(llm_dyn)
    REAL var_tmp2d(size(lon_in2)-1, size(pls_in, 2))
    real var_tmp3d(size(lon_in2), size(pls_in, 2), llm_dyn)
    REAL ax(llm_dyn), ay(llm_dyn), yder(llm_dyn)
    real var_ana3d(iml_dyn, jml_dyn, llm_dyn)

    !--------------------------------

    print *, "Call sequence information: start_inter_3d"

    iml = assert_eq(size(pls_in, 1), size(lon_in2), "start_inter_3d iml")
    jml = size(pls_in, 2)
    lml = size(pls_in, 3)

    print *, "iml = ", iml, ", jml = ", jml
    print *, 'Going into flinget to extract the 3D field.'
    print *, "fid_dyn = ", fid_dyn, ", varname = ", varname
    print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
         ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn
    CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &
         var_ana3d)

    CALL conf_dat3d(lon_ini, lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, &
         var_ana3d)

    DO il = 1, llm_dyn
       CALL inter_barxy(lon_rad, lat_rad(:jml_dyn-1), var_ana3d(:, :, il), &
            lon_in2(:iml-1), lat_in2, var_tmp2d) 
       var_tmp3d(:, :, il) = gr_int_dyn(var_tmp2d)
    ENDDO

    ! Pour l'interpolation verticale, on interpole du haut de l'atmosphère
    ! vers le sol :
    ax(:) = lev_dyn(llm_dyn:1:-1)
    DO ij=1, jml
       DO ii=1, iml-1
          ay(:) = var_tmp3d(ii, ij, llm_dyn:1:-1)
          yder(:) = SPLINE(ax, ay)
          do il=1, lml
             start_inter_3d(ii, ij, il) &
                  = SPLINT(ax, ay, yder, pls_in(ii, ij, il))
          END do
       ENDDO
    ENDDO
    start_inter_3d(iml, :, :) = start_inter_3d(1, :, :) 

  END function start_inter_3d

END MODULE startdyn
1	guez	3	MODULE startdyn
2
3			! From startvar.F, version 1.4
4			! 2006/01/27 15:14:22 Fairhead
5
6			IMPLICIT NONE
7
8			private
9			public start_init_dyn, start_inter_3d
10
11			INTEGER fid_dyn, iml_dyn, jml_dyn, llm_dyn, ttm_dyn
12
13			REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)
14			! (longitude and latitude from the input file, converted to rad)
15
16			real, ALLOCATABLE:: levdyn_ini(:)
17
18			CONTAINS
19
20			SUBROUTINE start_init_dyn(tsol_2d, psol)
21
22			! Host associated variables appearing and modified in this procedure :
23			! iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn, lon_ini, lat_ini, levdyn_ini
24
25			USE ioipsl, only: flininfo, flinopen_nozoom, flinget
26			use comgeom, only: aire_2d, apoln, apols
27			use conf_dat2d_m, only: conf_dat2d
28			use inter_barxy_m, only: inter_barxy
29			use comconst, only: pi
30			use comgeom, only: rlonu, rlatv
31			use dimens_m, only: iim, jjm
32			use gr_int_dyn_m, only: gr_int_dyn
33			use start_init_orog_m, only: phis
34			use start_init_phys_m, only: start_init_phys
35
36			REAL, intent(out):: tsol_2d(:, :)
37			REAL, intent(out):: psol(:, :) ! surface pressure, in Pa
38
39			! Local:
40
41			REAL date, dt
42			INTEGER itau(1)
43			INTEGER i, j
44
45			CHARACTER(len=120) physfname
46
47			REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
48
49			REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)
50			! (longitude and latitude from the input file, in rad or degrees)
51
52			REAL, ALLOCATABLE:: var_ana(:, :), z(:, :)
53			real tmp_var(iim, jjm + 1)
54			REAL, ALLOCATABLE:: xppn(:), xpps(:)
55
56			!--------------------------
57
58			print *, "Call sequence information: start_init_dyn"
59			if (any((/size(tsol_2d, 1), size(psol, 1)/) /= iim + 1)) stop &
60			"start_init_phys size 1"
61			if (any((/size(tsol_2d, 2), size(psol, 2)/) /= jjm + 1)) stop &
62			"start_init_phys size 2"
63			physfname = 'ECDYN.nc'
64			print *, 'Opening the surface analysis'
65			CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
66			print *, 'Values read from "' // trim(physfname) // '":'
67			print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
68			", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn
69
70			ALLOCATE(lat_dyn(iml_dyn, jml_dyn))
71			ALLOCATE(lon_dyn(iml_dyn, jml_dyn))
72			ALLOCATE(levdyn_ini(llm_dyn))
73
74			CALL flinopen_nozoom(physfname, iml_dyn, jml_dyn, llm_dyn, &
75			lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)
76
77			ALLOCATE(var_ana(iml_dyn, jml_dyn))
78			ALLOCATE(lon_rad(iml_dyn))
79			ALLOCATE(lon_ini(iml_dyn))
80
81			IF (MAXVAL(lon_dyn(:, :)) > pi) THEN
82			! Assume "lon_dyn" is in degrees
83			lon_ini(:) = lon_dyn(:, 1) * pi / 180.
84			ELSE
85			lon_ini(:) = lon_dyn(:, 1)
86			ENDIF
87
88			ALLOCATE(lat_rad(jml_dyn))
89			ALLOCATE(lat_ini(jml_dyn))
90
91			IF (MAXVAL(lat_dyn(:, :)) > pi) THEN
92			lat_ini(:) = lat_dyn(1, :) * pi / 180.
93			ELSE
94			lat_ini(:) = lat_dyn(1, :)
95			ENDIF
96
97			ALLOCATE(z(iim + 1, jjm + 1))
98
99			! 'Z': Surface geopotential
100			CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
101			CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
102			CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
103			rlatv, tmp_var)
104			z(:, :) = gr_int_dyn(tmp_var)
105
106			! 'SP': Surface pressure
107			CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
108			CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
109			CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
110			rlatv, tmp_var)
111			psol(:, :) = gr_int_dyn(tmp_var)
112			CALL start_init_phys(tsol_2d)
113
114			! PSOL is computed in Pascals
115
116			DO j = 1, jjm + 1
117			DO i = 1, iim
118			psol(i, j) = psol(i, j) &
119			* (1. + (z(i, j) - phis(i, j)) / 287. / tsol_2d(i, j))
120			ENDDO
121			ENDDO
122			psol(iim + 1, :) = psol(1, :)
123
124			ALLOCATE(xppn(iim))
125			ALLOCATE(xpps(iim))
126
127			DO i = 1, iim
128			xppn(i) = aire_2d( i, 1) * psol( i, 1)
129			xpps(i) = aire_2d( i, jjm + 1) * psol( i, jjm + 1)
130			ENDDO
131
132			psol(:, 1) = SUM(xppn)/apoln
133			psol(:, jjm + 1) = SUM(xpps)/apols
134
135			END SUBROUTINE start_init_dyn
136
137			!********************************
138
139			function start_inter_3d(varname, lon_in2, lat_in2, pls_in)
140
141			! This procedure gets a 3D variable from a file and does the
142			! interpolations needed.
143
144			USE ioipsl, only: flinget
145			use nrutil, only: assert_eq
146
147			use inter_barxy_m, only: inter_barxy
148			use interpolation, only: spline, splint
149			use gr_int_dyn_m, only: gr_int_dyn
150			use conf_dat3d_m, only: conf_dat3d
151
152			CHARACTER(len=*), intent(in):: varname
153			REAL, intent(in):: lon_in2(:), lat_in2(:)
154			REAL, intent(in):: pls_in(:, :, :)
155
156			REAL start_inter_3d(size(lon_in2), size(pls_in, 2), size(pls_in, 3))
157
158			! LOCAL:
159			INTEGER iml, jml, lml
160			INTEGER ii, ij, il
161			REAL lon_rad(iml_dyn), lat_rad(jml_dyn)
162			REAL lev_dyn(llm_dyn)
163			REAL var_tmp2d(size(lon_in2)-1, size(pls_in, 2))
164			real var_tmp3d(size(lon_in2), size(pls_in, 2), llm_dyn)
165			REAL ax(llm_dyn), ay(llm_dyn), yder(llm_dyn)
166			real var_ana3d(iml_dyn, jml_dyn, llm_dyn)
167
168			!--------------------------------
169
170			print *, "Call sequence information: start_inter_3d"
171
172			iml = assert_eq(size(pls_in, 1), size(lon_in2), "start_inter_3d iml")
173			jml = size(pls_in, 2)
174			lml = size(pls_in, 3)
175
176			print *, "iml = ", iml, ", jml = ", jml
177			print *, 'Going into flinget to extract the 3D field.'
178			print *, "fid_dyn = ", fid_dyn, ", varname = ", varname
179			print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
180			", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn
181			CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &
182			var_ana3d)
183
184			CALL conf_dat3d(lon_ini, lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, &
185			var_ana3d)
186
187			DO il = 1, llm_dyn
188			CALL inter_barxy(lon_rad, lat_rad(:jml_dyn-1), var_ana3d(:, :, il), &
189			lon_in2(:iml-1), lat_in2, var_tmp2d)
190			var_tmp3d(:, :, il) = gr_int_dyn(var_tmp2d)
191			ENDDO
192
193			! Pour l'interpolation verticale, on interpole du haut de l'atmosphère
194			! vers le sol :
195			ax(:) = lev_dyn(llm_dyn:1:-1)
196			DO ij=1, jml
197			DO ii=1, iml-1
198			ay(:) = var_tmp3d(ii, ij, llm_dyn:1:-1)
199			yder(:) = SPLINE(ax, ay)
200			do il=1, lml
201			start_inter_3d(ii, ij, il) &
202			= SPLINT(ax, ay, yder, pls_in(ii, ij, il))
203			END do
204			ENDDO
205			ENDDO
206			start_inter_3d(iml, :, :) = start_inter_3d(1, :, :)
207
208			END function start_inter_3d
209
210			END MODULE startdyn