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

Last change on this file since 5136 was 5117, checked in by abarral, 2 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

  • 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.0 KB
Line 
1
2! $Id: hgardfou.F90 5117 2024-07-24 14:23:34Z abarral $
3SUBROUTINE hgardfou(t, tsol, text,abortphy)
4  USE dimphy, ONLY: klon, klev
5  USE phys_state_var_mod, ONLY: pctsrf
6  USE lmdz_geometry, ONLY: longitude_deg, latitude_deg
7  USE indice_sol_mod, ONLY: nbsrf
8  USE lmdz_print_control, ONLY: lunout
9  IMPLICIT NONE
10  ! ======================================================================
11  ! Verifier la temperature
12  ! ======================================================================
13  include "YOMCST.h"
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.