trunk/phylmd/hgardfou.f90

module hgardfou_m

  IMPLICIT none

contains

  SUBROUTINE hgardfou(t_seri, ftsol)

    ! From phylmd/hgardfou.F, v 1.1.1.1, 2004/05/19 12:53:07

    ! This procedure aborts the program if the temperature gets out of range.

    use abort_gcm_m, only: abort_gcm
    USE indicesol, ONLY: nbsrf, clnsurf
    USE dimphy, ONLY: klev, klon
    use nr_util, only: ifirstloc
    use phyetat0_m, only: rlon, rlat

    REAL, intent(in):: t_seri(:, :) ! (klon, klev)
    REAL, intent(in):: ftsol(:, :) ! (klon, nbsrf)

    ! Variables local to the procedure:

    real, parameter:: temp_min = 50., temp_max = 370. ! temperature range, in K
    INTEGER k, nsrf, jbad

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

    DO k = 1, klev
       jbad = ifirstloc(t_seri(:, k) > temp_max .or. t_seri(:, k) < temp_min)
       if (jbad <= klon) then
          print *, "t_seri(", jbad, ", ", k, ") = ", t_seri(jbad, k)
          call abort_gcm('hgardfou', 'temperature out of range')
       end if
    ENDDO

    DO nsrf = 1, nbsrf
       jbad = ifirstloc(ftsol(:, nsrf) > temp_max &
            .or. ftsol(:, nsrf) < temp_min)
       if (jbad <= klon) then
          print *, "ftsol(position index =", jbad, ", sub-surface index =", &
               nsrf, ") =", ftsol(jbad, nsrf)
          print *, "sub-surface name: ", clnsurf(nsrf)
          print *, "longitude:", rlon(jbad), "degrees east"
          print *, "latitude:", rlat(jbad), "degrees north"
          call abort_gcm('hgardfou', 'temperature out of range')
       ENDIF
    ENDDO

  END SUBROUTINE hgardfou

end module hgardfou_m
1	guez	3	module hgardfou_m
2
3			IMPLICIT none
4
5			contains
6
7	guez	222	SUBROUTINE hgardfou(t_seri, ftsol)
8	guez	3
9	guez	221	! From phylmd/hgardfou.F, v 1.1.1.1, 2004/05/19 12:53:07
10	guez	3
11			! This procedure aborts the program if the temperature gets out of range.
12
13	guez	227	use abort_gcm_m, only: abort_gcm
14			USE indicesol, ONLY: nbsrf, clnsurf
15	guez	69	USE dimphy, ONLY: klev, klon
16	guez	70	use nr_util, only: ifirstloc
17	guez	227	use phyetat0_m, only: rlon, rlat
18	guez	3
19	guez	222	REAL, intent(in):: t_seri(:, :) ! (klon, klev)
20			REAL, intent(in):: ftsol(:, :) ! (klon, nbsrf)
21	guez	3
22			! Variables local to the procedure:
23
24			real, parameter:: temp_min = 50., temp_max = 370. ! temperature range, in K
25	guez	70	INTEGER k, nsrf, jbad
26	guez	3
27			!----------------------------------------------------------
28
29			DO k = 1, klev
30	guez	222	jbad = ifirstloc(t_seri(:, k) > temp_max .or. t_seri(:, k) < temp_min)
31	guez	70	if (jbad <= klon) then
32	guez	222	print *, "t_seri(", jbad, ", ", k, ") = ", t_seri(jbad, k)
33	guez	227	call abort_gcm('hgardfou', 'temperature out of range')
34	guez	70	end if
35	guez	3	ENDDO
36
37			DO nsrf = 1, nbsrf
38	guez	207	jbad = ifirstloc(ftsol(:, nsrf) > temp_max &
39			.or. ftsol(:, nsrf) < temp_min)
40	guez	70	if (jbad <= klon) then
41	guez	227	print *, "ftsol(position index =", jbad, ", sub-surface index =", &
42			nsrf, ") =", ftsol(jbad, nsrf)
43			print *, "sub-surface name: ", clnsurf(nsrf)
44			print *, "longitude:", rlon(jbad), "degrees east"
45			print *, "latitude:", rlat(jbad), "degrees north"
46			call abort_gcm('hgardfou', 'temperature out of range')
47	guez	3	ENDIF
48			ENDDO
49
50			END SUBROUTINE hgardfou
51
52			end module hgardfou_m