/[lmdze]/trunk/dyn3d/Inter_barxy/inter_barxy.f
ViewVC logotype

Contents of /trunk/dyn3d/Inter_barxy/inter_barxy.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 266 - (show annotations)
Thu Apr 19 17:54:55 2018 UTC (5 years, 11 months ago) by guez
File size: 3194 byte(s)
Define macros of the preprocessor CPP_IIM, CPP_JJM, CPP_LLM so we can
control the resolution from the compilation command, and automate
compilation for several resolutions.

In module yoethf_m, transform variables into named constants. So we do
not need procedure yoethf any longer.

Bug fix in program test_inter_barxy, missing calls to fyhyp and fxhyp,
and definition of rlatu.

Remove variable iecri of module conf_gcm_m. The files dyn_hist*.nc are
written every time step. We are simplifying the output system, pending
replacement by a whole new system.

Modify possible value of vert_sampling from "param" to
"strato_custom", following LMDZ. Default values of corresponding
namelist variables are now the values used for LMDZ CMIP6.

1 module inter_barxy_m
2
3 ! From inter_barxy.F, version 1.1.1.1, 2004/05/19 12:53:07
4
5 implicit none
6
7 contains
8
9 SUBROUTINE inter_barxy(dlonid, dlatid, champ, rlonimod, rlatimod, champint)
10
11 ! Author: P. Le Van
12
13 use comgeom, only: aire_2d, apoln, apols
14 use dimensions, only: iim, jjm
15 use inter_barx_m, only: inter_barx
16 use inter_bary_m, only: inter_bary
17 use nr_util, only: assert_eq, assert
18 use ord_coord_m, only: ord_coord
19 use ord_coordm_m, only: ord_coordm
20
21 REAL, intent(in):: dlonid(:)
22 ! longitude from input file, in rad, from -pi to pi
23
24 REAL, intent(in):: dlatid(:), champ(:, :), rlonimod(:)
25
26 REAL, intent(in):: rlatimod(:)
27 ! latitude angle, in degrees or rad, in strictly decreasing order
28
29 real, intent(out):: champint(:, :)
30 ! Si taille de la seconde dim = jjm + 1, on veut interpoler sur les
31 ! jjm+1 latitudes rlatu du modele (latitudes des scalaires et de U)
32 ! Si taille de la seconde dim = jjm, on veut interpoler sur les
33 ! jjm latitudes rlatv du mod\`ele (latitudes de V)
34
35 ! Local:
36
37 REAL champy(iim, size(champ, 2))
38 integer j, i, jnterfd, jmods
39
40 REAL yjmod(size(champint, 2))
41 ! (angle, in degrees, in strictly increasing order)
42
43 REAL yjdat(size(dlatid) + 1) ! angle, in degrees, in increasing order
44 LOGICAL decrois ! "dlatid" is in decreasing order
45
46 !-----------------------------------
47
48 jnterfd = assert_eq(size(champ, 2) - 1, size(dlatid), "inter_barxy jnterfd")
49 jmods = size(champint, 2)
50 call assert(size(champ, 1) == size(dlonid), "inter_barxy size(champ, 1)")
51 call assert((/size(rlonimod), size(champint, 1)/) == iim, &
52 "inter_barxy iim")
53 call assert(any(jmods == (/jjm, jjm + 1/)), 'inter_barxy jmods')
54 call assert(size(rlatimod) == jjm, "inter_barxy size(rlatimod)")
55
56 ! Check decreasing order for "rlatimod":
57 DO i = 2, jjm
58 IF (rlatimod(i) >= rlatimod(i-1)) then
59 print *, '"inter_barxy": "rlatimod" should be strictly decreasing'
60 stop 1
61 end IF
62 ENDDO
63
64 yjmod(:jjm) = ord_coordm(rlatimod)
65 IF (jmods == jjm + 1) THEN
66 IF (90. - yjmod(jjm) < 0.01) then
67 print *, '"inter_barxy": with jmods = jjm + 1, ' &
68 // 'yjmod(jjm) should be < 90.'
69 stop 1
70 end IF
71 ELSE
72 ! jmods = jjm
73 IF (ABS(yjmod(jjm) - 90.) > 0.01) then
74 print *, '"inter_barxy": with jmods = jjm, yjmod(jjm) should be 90.'
75 stop 1
76 end IF
77 ENDIF
78
79 if (jmods == jjm + 1) yjmod(jjm + 1) = 90.
80
81 DO j = 1, jnterfd + 1
82 champy(:, j) = inter_barx(dlonid, champ(:, j), rlonimod)
83 ENDDO
84
85 CALL ord_coord(dlatid, yjdat, decrois)
86 IF (decrois) champy(:, :) = champy(:, jnterfd + 1:1:-1)
87 DO i = 1, iim
88 champint(i, :) = inter_bary(yjdat, champy(i, :), yjmod)
89 ENDDO
90 champint(:, :) = champint(:, jmods:1:-1)
91
92 IF (jmods == jjm + 1) THEN
93 ! Valeurs uniques aux poles
94 champint(:, 1) = SUM(aire_2d(:iim, 1) * champint(:, 1)) / apoln
95 champint(:, jjm + 1) = SUM(aire_2d(:iim, jjm + 1) &
96 * champint(:, jjm + 1)) / apols
97 ENDIF
98
99 END SUBROUTINE inter_barxy
100
101 end module inter_barxy_m

  ViewVC Help
Powered by ViewVC 1.1.21