dyn3d/Guide/conf_guide.f

module conf_guide_m

  USE dimens_m, ONLY: iim, jjm

  IMPLICIT NONE

  LOGICAL:: ini_anal = .false. ! Initial = analyse
  LOGICAL:: guide_u = .false. ! guidage de u
  LOGICAL:: guide_v = .false. ! gvidage de v
  LOGICAL:: guide_t = .false. ! guidage de T
  LOGICAL:: guide_q = .false. ! guidage de q

  logical, save:: ok_guide ! guidage

  ! alpha détermine la part des injections de données à chaque étape
  ! alpha=0 signifie pas d'injection
  ! alpha=1 signifie injection totale
  REAL, save:: alpha_q(iim + 1, jjm + 1)
  REAL, save:: alpha_t(iim + 1, jjm + 1)
  REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)

  private iim, jjm

contains

  SUBROUTINE conf_guide

    ! From LMDZ4/libf/dyn3d/conf_guide.F, version 1.1.1.1 2004/05/19 12:53:07
    !  Parametres de controle du run:

    use abort_gcm_m, only: abort_gcm
    use comconst, only: daysec, dtvr
    use conf_gcm_m, only: day_step, iperiod
    use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv
    use init_tau2alpha_m, only: init_tau2alpha
    use nr_util, only: assert, pi
    use tau2alpha_m, only: tau2alpha
    use unit_nml_m, only: unit_nml
    use writefield_m, only: writefield

    ! Local:

    ! Constantes de rappel, en jours :
    REAL tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t
    real tau_min_q, tau_max_q

    REAL lat_min_guide_deg, lat_max_guide_deg ! in degrees

    ! Dans le cas où on n'a les analyses que sur une bande de latitudes :
    REAL lat_min_guide ! minimum latitude for nudging, in rad
    real lat_max_guide ! maximum latitude for nudging, in rad

    REAL factt ! pas de temps entre deux appels au guidage, en jours
    REAL dxdys(iim + 1, jjm + 1), dxdyu(iim + 1, jjm + 1), dxdyv(iim + 1, jjm)
    integer i, j

    namelist /conf_guide_nml/ ini_anal, guide_u, guide_v, guide_t, guide_q, &
         tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t, &
         tau_min_q, tau_max_q, lat_min_guide_deg, lat_max_guide_deg

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

    print *, "Call sequence information: conf_guide"

    ! Default values:
    tau_min_u = 0.03
    tau_max_u = 10.
    tau_min_v = 0.03
    tau_max_v = 10.
    tau_min_t = 0.03
    tau_max_t = 10.
    tau_min_q = 0.03
    tau_max_q = 10.
    lat_min_guide_deg = -90.
    lat_max_guide_deg = 90.

    print *, "Enter namelist 'conf_guide_nml'."
    read(unit=*, nml=conf_guide_nml)
    write(unit_nml, nml=conf_guide_nml)

    ok_guide = any((/guide_u, guide_v, guide_t, guide_q/))

    if (ok_guide) then
       call assert(mod(day_step, 4 * iperiod) == 0, &
            "conf_guide ok_guide day_step iperiod")
       lat_min_guide = lat_min_guide_deg / 180. * pi
       lat_max_guide = lat_max_guide_deg / 180. * pi
       factt = dtvr * iperiod / daysec
       print *, "factt = ", factt

       IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
          ! grille regulière
          if (guide_u) alpha_u = 1. - exp(- factt / tau_max_u)
          if (guide_v) alpha_v = 1. - exp(- factt / tau_max_v)
          if (guide_t) alpha_t = 1. - exp(- factt / tau_max_t)
          if (guide_q) alpha_q = 1. - exp(- factt / tau_max_q)
       else
          call init_tau2alpha(dxdys)

          if (guide_u) then
             DO j = 1, jjm + 1
                DO i = 1, iim
                   dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
                END DO
                dxdyu(iim + 1, j) = dxdyu(1, j)
             END DO

             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyu, rlatu, &
                  tau_min_u, tau_max_u, alpha_u)
             CALL writefield("alpha_u", alpha_u)
          end if

          if (guide_v) then
             DO j = 1, jjm
                DO i = 1, iim + 1
                   dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
                END DO
             END DO

             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyv, rlatv, &
                  tau_min_v, tau_max_v, alpha_v)
             CALL writefield("alpha_v", alpha_v)
          end if

          if (guide_t) then
             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
                  tau_min_t, tau_max_t, alpha_t)
             CALL writefield("alpha_t", alpha_t)
          end if

          if (guide_q)  then
             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
                  tau_min_q, tau_max_q, alpha_q)
             CALL writefield("alpha_q", alpha_q)
          end if
       end IF
    end if

  end SUBROUTINE conf_guide

end module conf_guide_m
1	module conf_guide_m
2
3	USE dimens_m, ONLY: iim, jjm
4
5	IMPLICIT NONE
6
7	LOGICAL:: ini_anal = .false. ! Initial = analyse
8	LOGICAL:: guide_u = .false. ! guidage de u
9	LOGICAL:: guide_v = .false. ! gvidage de v
10	LOGICAL:: guide_t = .false. ! guidage de T
11	LOGICAL:: guide_q = .false. ! guidage de q
12
13	logical, save:: ok_guide ! guidage
14
15	! alpha détermine la part des injections de données à chaque étape
16	! alpha=0 signifie pas d'injection
17	! alpha=1 signifie injection totale
18	REAL, save:: alpha_q(iim + 1, jjm + 1)
19	REAL, save:: alpha_t(iim + 1, jjm + 1)
20	REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)
21
22	private iim, jjm
23
24	contains
25
26	SUBROUTINE conf_guide
27
28	! From LMDZ4/libf/dyn3d/conf_guide.F, version 1.1.1.1 2004/05/19 12:53:07
29	! Parametres de controle du run:
30
31	use abort_gcm_m, only: abort_gcm
32	use comconst, only: daysec, dtvr
33	use conf_gcm_m, only: day_step, iperiod
34	use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv
35	use init_tau2alpha_m, only: init_tau2alpha
36	use nr_util, only: assert, pi
37	use tau2alpha_m, only: tau2alpha
38	use unit_nml_m, only: unit_nml
39	use writefield_m, only: writefield
40
41	! Local:
42
43	! Constantes de rappel, en jours :
44	REAL tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t
45	real tau_min_q, tau_max_q
46
47	REAL lat_min_guide_deg, lat_max_guide_deg ! in degrees
48
49	! Dans le cas où on n'a les analyses que sur une bande de latitudes :
50	REAL lat_min_guide ! minimum latitude for nudging, in rad
51	real lat_max_guide ! maximum latitude for nudging, in rad
52
53	REAL factt ! pas de temps entre deux appels au guidage, en jours
54	REAL dxdys(iim + 1, jjm + 1), dxdyu(iim + 1, jjm + 1), dxdyv(iim + 1, jjm)
55	integer i, j
56
57	namelist /conf_guide_nml/ ini_anal, guide_u, guide_v, guide_t, guide_q, &
58	tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t, &
59	tau_min_q, tau_max_q, lat_min_guide_deg, lat_max_guide_deg
60
61	!-----------------------------------------------------------------------
62
63	print *, "Call sequence information: conf_guide"
64
65	! Default values:
66	tau_min_u = 0.03
67	tau_max_u = 10.
68	tau_min_v = 0.03
69	tau_max_v = 10.
70	tau_min_t = 0.03
71	tau_max_t = 10.
72	tau_min_q = 0.03
73	tau_max_q = 10.
74	lat_min_guide_deg = -90.
75	lat_max_guide_deg = 90.
76
77	print *, "Enter namelist 'conf_guide_nml'."
78	read(unit=*, nml=conf_guide_nml)
79	write(unit_nml, nml=conf_guide_nml)
80
81	ok_guide = any((/guide_u, guide_v, guide_t, guide_q/))
82
83	if (ok_guide) then
84	call assert(mod(day_step, 4 * iperiod) == 0, &
85	"conf_guide ok_guide day_step iperiod")
86	lat_min_guide = lat_min_guide_deg / 180. * pi
87	lat_max_guide = lat_max_guide_deg / 180. * pi
88	factt = dtvr * iperiod / daysec
89	print *, "factt = ", factt
90
91	IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
92	! grille regulière
93	if (guide_u) alpha_u = 1. - exp(- factt / tau_max_u)
94	if (guide_v) alpha_v = 1. - exp(- factt / tau_max_v)
95	if (guide_t) alpha_t = 1. - exp(- factt / tau_max_t)
96	if (guide_q) alpha_q = 1. - exp(- factt / tau_max_q)
97	else
98	call init_tau2alpha(dxdys)
99
100	if (guide_u) then
101	DO j = 1, jjm + 1
102	DO i = 1, iim
103	dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
104	END DO
105	dxdyu(iim + 1, j) = dxdyu(1, j)
106	END DO
107
108	CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyu, rlatu, &
109	tau_min_u, tau_max_u, alpha_u)
110	CALL writefield("alpha_u", alpha_u)
111	end if
112
113	if (guide_v) then
114	DO j = 1, jjm
115	DO i = 1, iim + 1
116	dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
117	END DO
118	END DO
119
120	CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyv, rlatv, &
121	tau_min_v, tau_max_v, alpha_v)
122	CALL writefield("alpha_v", alpha_v)
123	end if
124
125	if (guide_t) then
126	CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
127	tau_min_t, tau_max_t, alpha_t)
128	CALL writefield("alpha_t", alpha_t)
129	end if
130
131	if (guide_q) then
132	CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
133	tau_min_q, tau_max_q, alpha_q)
134	CALL writefield("alpha_q", alpha_q)
135	end if
136	end IF
137	end if
138
139	end SUBROUTINE conf_guide
140
141	end module conf_guide_m