source: LMDZ4/trunk/libf/phylmd/calcul_simulISCCP.h @ 1195

Last change on this file since 1195 was 1045, checked in by lmdzadmin, 16 years ago

On sort meantaucld dans histISCCP, car sortie simulateur (enleve du histday)
Lecture fichiers input ISCCP "debut" physiq
IM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.2 KB
Line 
1c
2c $Header$
3c
4c on appelle le simulateur ISCCP toutes les 3h
5c et on fait des sorties 1 fois par jour
6c
7c ATTENTION : le temps de calcul peut augmenter considerablement !
8c =============================================================== c
9      DO n=1, napisccp
10c
11      nbapp_isccp=30 !appel toutes les 15h
12cIM 170107      isccppas=NINT((itap*dtime)/3600.) !Nb. d'heures de la physique
13      freqin_pdt(n)=ifreq_isccp(n)
14c
15cIM initialisation nbsunlit pour calculs simulateur ISCCP pdt la journee
16c
17      DO i=1, klon
18       sunlit(i)=1 
19       IF(rmu0(i).EQ.0.) sunlit(i)=0
20       nbsunlit(1,i,n)=FLOAT(sunlit(i))
21      ENDDO
22c
23cIM calcul tau, emissivite nuages convectifs
24c
25      convfra(:,:)=rnebcon(:,:)
26      convliq(:,:)=rnebcon(:,:)*clwcon(:,:)
27c
28      CALL newmicro (paprs, pplay,ok_newmicro,
29     .            t_seri, convliq, convfra, dtau_c, dem_c,
30     .            cldh_c, cldl_c, cldm_c, cldt_c, cldq_c,
31     .            flwp_c, fiwp_c, flwc_c, fiwc_c,
32     e            ok_aie,
33     e            sulfate, sulfate_pi,
34     e            bl95_b0, bl95_b1,
35     s            cldtaupi, re, fl)
36c
37cIM calcul tau, emissivite nuages startiformes
38c
39      CALL newmicro (paprs, pplay,ok_newmicro,
40     .            t_seri, cldliq, cldfra, dtau_s, dem_s,
41     .            cldh_s, cldl_s, cldm_s, cldt_s, cldq_s,
42     .            flwp_s, fiwp_s, flwc_s, fiwc_s,
43     e            ok_aie,
44     e            sulfate, sulfate_pi,
45     e            bl95_b0, bl95_b1,
46     s            cldtaupi, re, fl)
47c
48      cldtot(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
49c
50cIM inversion des niveaux de pression ==> de haut en bas
51c
52      CALL haut2bas(klon, klev, pplay, pfull)
53      CALL haut2bas(klon, klev, q_seri, qv)
54      CALL haut2bas(klon, klev, cldtot, cc)
55      CALL haut2bas(klon, klev, rnebcon, conv)
56      CALL haut2bas(klon, klev, dtau_s, dtau_sH2B)
57      CALL haut2bas(klon, klev, dtau_c, dtau_cH2B)
58      CALL haut2bas(klon, klev, t_seri, at)
59      CALL haut2bas(klon, klev, dem_s, dem_sH2B)
60      CALL haut2bas(klon, klev, dem_c, dem_cH2B)
61      CALL haut2bas(klon, klevp1, paprs, phalf)
62c
63cIM: initialisation de seed
64c
65        DO i=1, klon
66c
67         aa=ABS(paprs(i,2)-NINT(paprs(i,2)))
68         seed_re(i,n)=1000.*aa+1.
69         seed(i,n)=NINT(seed_re(i,n))
70c
71         IF(seed(i,n).LT.50) THEN
72c          print*,'seed<50 avant i seed itap paprs',i,
73c    .     seed(i,n),itap,paprs(i,2)
74           seed(i,n)=50+seed(i,n)+i+itap
75           seed_old(i,n)=seed(i,n)
76c
77           IF(itap.GT.1) then
78            IF(seed(i,n).EQ.seed_old(i,n)) THEN
79             seed(i,n)=seed(i,n)+10
80             seed_old(i,n)=seed(i,n)
81            ENDIF
82           ENDIF
83c
84c          print*,'seed<50 apres i seed itap paprs',i,
85c    .     seed(i,n),itap,paprs(i,2)
86c
87          ELSE IF(seed(i,n).EQ.0) THEN
88           print*,'seed=0 i paprs aa seed_re',
89     .     i,paprs(i,2),aa,seed_re(i,n)
90           STOP
91          ELSE IF(seed(i,n).LT.0) THEN
92           print*,'seed < 0, i seed itap paprs',i,
93     .     seed(i,n),itap,paprs(i,2)
94           STOP
95          ENDIF
96c
97        ENDDO
98c     
99cIM: pas de debug, debugcol
100      debug=0
101      debugcol=0
102c
103cIM o500 ==> distribution nuage ftion du regime dynamique (vit. verticale a 500 hPa)
104c
105        DO k=1, klevm1
106        kp1=k+1
107c       PRINT*,'k, presnivs',k,presnivs(k), presnivs(kp1)
108        if(presnivs(k).GT.50000.AND.presnivs(kp1).LT.50000.) THEN
109         DO i=1, klon
110          o500(i)=omega(i,k)*RDAY/100.
111c         if(i.EQ.1) print*,' 500hPa lev',k,presnivs(k),presnivs(kp1)
112         ENDDO
113         GOTO 1000
114        endif
1151000  continue
116      ENDDO
117c
118cIM recalcule les nuages vus par satellite, via le simulateur ISCCP
119c
120      CALL ISCCP_CLOUD_TYPES(
121     &     debug,
122     &     debugcol,
123     &     klon,
124     &     sunlit,
125     &     klev,
126     &     ncol(n),
127     &     seed(:,n),
128     &     pfull,
129     &     phalf,
130     &     qv, cc, conv, dtau_sH2B, dtau_cH2B,
131     &     top_height,
132     &     overlap,
133     &     tautab,
134     &     invtau,
135     &     ztsol,
136     &     emsfc_lw,
137     &     at, dem_sH2B, dem_cH2B,
138     &     fq_isccp(:,:,:,n),
139     &     totalcldarea(:,n),
140     &     meanptop(:,n),
141     &     meantaucld(:,n),
142     &     boxtau(:,:,n),
143     &     boxptop(:,:,n))
144c
145      ENDDO !n=1, napisccp
146
Note: See TracBrowser for help on using the repository browser.