source: LMDZ6/branches/Amaury_dev/libf/phylmd/hgardfou.F90

Last change on this file was 5144, checked in by abarral, 3 months ago

Put YOMCST.h into modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
Line 
1! $Id: hgardfou.F90 5144 2024-07-29 21:01:04Z fairhead $
2SUBROUTINE hgardfou(t, tsol, text, abortphy)
3  USE dimphy, ONLY: klon, klev
4  USE phys_state_var_mod, ONLY: pctsrf
5  USE lmdz_geometry, ONLY: longitude_deg, latitude_deg
6  USE indice_sol_mod, ONLY: nbsrf
7  USE lmdz_print_control, ONLY: lunout
8  USE lmdz_yomcst
9
10  IMPLICIT NONE
11  ! ======================================================================
12  ! Verifier la temperature
13  ! ======================================================================
14  REAL t(klon, klev), tsol(klon, nbsrf)
15  CHARACTER(len = *), INTENT(IN) :: text
16  CHARACTER (LEN = 20) :: modname = 'hgardfou'
17  INTEGER abortphy
18
19  INTEGER i, k, nsrf
20  REAL zt(klon)
21  INTEGER jadrs(klon), jbad
22  LOGICAL ok
23
24  LOGICAL firstcall
25  SAVE firstcall
26  DATA firstcall/.TRUE./
27  !$OMP THREADPRIVATE(firstcall)
28
29  IF (firstcall) THEN
30    WRITE (lunout, *) 'hgardfou garantit la temperature dans [100,370] K'
31    firstcall = .FALSE.
32    ! DO i = 1, klon
33    ! WRITE(lunout,*)'i=',i,'rlon=',rlon(i),'rlat=',rlat(i)
34    ! ENDDO
35
36  END IF
37
38  ok = .TRUE.
39  DO k = 1, klev
40    DO i = 1, klon
41      zt(i) = t(i, k)
42    END DO
43    jbad = 0
44    DO i = 1, klon
45      IF (zt(i)>370.) THEN
46        jbad = jbad + 1
47        jadrs(jbad) = i
48      END IF
49    END DO
50    IF (jbad>0) THEN
51      ok = .FALSE.
52      DO i = 1, jbad
53        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
54                jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
55                latitude_deg(jadrs(i)), (pctsrf(jadrs(i), nsrf), nsrf = 1, nbsrf)
56      END DO
57    END IF
58    jbad = 0
59    DO i = 1, klon
60      ! IF (zt(i).LT.100.0) THEN
61      IF (zt(i)<50.0) THEN
62        jbad = jbad + 1
63        jadrs(jbad) = i
64      END IF
65    END DO
66    IF (jbad>0) THEN
67      ok = .FALSE.
68      DO i = 1, jbad
69        WRITE (lunout, *) 'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =', &
70                jadrs(i), k, zt(jadrs(i)), longitude_deg(jadrs(i)), &
71                latitude_deg(jadrs(i)), (pctsrf(jadrs(i), nsrf), nsrf = 1, nbsrf)
72      END DO
73    END IF
74  END DO
75
76  DO nsrf = 1, nbsrf
77    DO i = 1, klon
78      zt(i) = tsol(i, nsrf)
79    END DO
80    jbad = 0
81    DO i = 1, klon
82      IF (zt(i)>370.0) THEN
83        jbad = jbad + 1
84        jadrs(jbad) = i
85      END IF
86    END DO
87    IF (jbad>0) THEN
88      ok = .FALSE.
89      DO i = 1, jbad
90        WRITE (lunout, *) &
91                'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
92                nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
93                latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
94      END DO
95    END IF
96    jbad = 0
97    DO i = 1, klon
98      ! IF (zt(i).LT.100.0) THEN
99      IF (zt(i)<50.0) THEN
100        jbad = jbad + 1
101        jadrs(jbad) = i
102      END IF
103    END DO
104    IF (jbad>0) THEN
105      ok = .FALSE.
106      DO i = 1, jbad
107        WRITE (lunout, *) &
108                'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic =', jadrs(i), &
109                nsrf, zt(jadrs(i)), longitude_deg(jadrs(i)), &
110                latitude_deg(jadrs(i)), pctsrf(jadrs(i), nsrf)
111      END DO
112    END IF
113  END DO
114
115  !  IF (.NOT. ok) CALL abort_physic(modname, text, 1)
116  IF (.NOT. ok) abortphy = 1
117
118END SUBROUTINE hgardfou
Note: See TracBrowser for help on using the repository browser.