| 1 | ! |
|---|
| 2 | ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histins.h,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $ |
|---|
| 3 | ! |
|---|
| 4 | IF (ok_instan) THEN |
|---|
| 5 | |
|---|
| 6 | zsto = dtime * REAL(ecrit_ins) |
|---|
| 7 | zout = dtime * REAL(ecrit_ins) |
|---|
| 8 | itau_w = itau_phy + itap |
|---|
| 9 | |
|---|
| 10 | c------------------------------------------------------- |
|---|
| 11 | IF(lev_histday.GE.1) THEN |
|---|
| 12 | |
|---|
| 13 | ccccccccccccc 2D fields, invariables |
|---|
| 14 | |
|---|
| 15 | call histwrite_phy(nid_ins,.false.,"phis",itau_w,pphis) |
|---|
| 16 | call histwrite_phy(nid_ins,.false.,"aire",itau_w,airephy) |
|---|
| 17 | |
|---|
| 18 | ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement... |
|---|
| 19 | do i=1,klon |
|---|
| 20 | tmpout(i,1) = zls*180./RPI |
|---|
| 21 | enddo |
|---|
| 22 | call histwrite_phy(nid_ins,.false.,"ls",itau_w,tmpout(:,1)) |
|---|
| 23 | |
|---|
| 24 | ccccccccccccc 2D fields, variables |
|---|
| 25 | |
|---|
| 26 | call histwrite_phy(nid_ins,.false.,"tsol",itau_w,ftsol) |
|---|
| 27 | call histwrite_phy(nid_ins,.false.,"psol",itau_w,paprs(:,1)) |
|---|
| 28 | |
|---|
| 29 | c call histwrite_phy(nid_ins,.false.,"ue",itau_w,ue) |
|---|
| 30 | c call histwrite_phy(nid_ins,.false.,"ve",itau_w,ve) |
|---|
| 31 | |
|---|
| 32 | ENDIF !lev_histday.GE.1 |
|---|
| 33 | |
|---|
| 34 | c------------------------------------------------------- |
|---|
| 35 | IF(lev_histday.GE.2) THEN |
|---|
| 36 | |
|---|
| 37 | ccccccccccccc 3D fields, basics |
|---|
| 38 | |
|---|
| 39 | call histwrite_phy(nid_ins,.false.,"temp",itau_w,t_seri) |
|---|
| 40 | call histwrite_phy(nid_ins,.false.,"pres",itau_w,pplay) |
|---|
| 41 | call histwrite_phy(nid_ins,.false.,"geop",itau_w,zphi) |
|---|
| 42 | call histwrite_phy(nid_ins,.false.,"vitu",itau_w,u_seri) |
|---|
| 43 | call histwrite_phy(nid_ins,.false.,"vitv",itau_w,v_seri) |
|---|
| 44 | call histwrite_phy(nid_ins,.false.,"vitw",itau_w,omega) |
|---|
| 45 | call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw) |
|---|
| 46 | c call histwrite_phy(nid_ins,.false.,"duvdf",itau_w,d_u_vdf) |
|---|
| 47 | c call histwrite_phy(nid_ins,.false.,"dudyn",itau_w,d_u_dyn) |
|---|
| 48 | |
|---|
| 49 | ENDIF !lev_histday.GE.2 |
|---|
| 50 | |
|---|
| 51 | c------------------------------------------------------- |
|---|
| 52 | IF(lev_histday.GE.3) THEN |
|---|
| 53 | |
|---|
| 54 | cccccccccccccccccc Tracers |
|---|
| 55 | |
|---|
| 56 | if (iflag_trac.eq.1) THEN |
|---|
| 57 | if (microfi.eq.1) then |
|---|
| 58 | DO iq=1,nmicro |
|---|
| 59 | call histwrite_phy(nid_ins,.false.,tname(iq), |
|---|
| 60 | . itau_w,qaer(1:klon,1:klev,iq)) |
|---|
| 61 | ENDDO |
|---|
| 62 | endif |
|---|
| 63 | if (nmicro.lt.nqmax) then |
|---|
| 64 | DO iq=nmicro+1,nqmax |
|---|
| 65 | call histwrite_phy(nid_ins,.false.,tname(iq), |
|---|
| 66 | . itau_w,tr_seri(1:klon,1:klev,iq)) |
|---|
| 67 | ENDDO |
|---|
| 68 | endif |
|---|
| 69 | endif |
|---|
| 70 | |
|---|
| 71 | cccccccccccccccccc Radiative transfer |
|---|
| 72 | |
|---|
| 73 | c 2D |
|---|
| 74 | |
|---|
| 75 | call histwrite_phy(nid_ins,.false.,"topl",itau_w,toplw) |
|---|
| 76 | call histwrite_phy(nid_ins,.false.,"sols",itau_w,solsw) |
|---|
| 77 | call histwrite_phy(nid_ins,.false.,"soll",itau_w,sollw) |
|---|
| 78 | |
|---|
| 79 | c 3D |
|---|
| 80 | |
|---|
| 81 | call histwrite_phy(nid_ins,.false.,"SWnet", |
|---|
| 82 | . itau_w,swnet(1:klon,1:klev)) |
|---|
| 83 | call histwrite_phy(nid_ins,.false.,"LWnet", |
|---|
| 84 | . itau_w,lwnet(1:klon,1:klev)) |
|---|
| 85 | |
|---|
| 86 | c -------------- |
|---|
| 87 | c ----- OPACITE BRUME |
|---|
| 88 | do k=7,NSPECV,10 |
|---|
| 89 | do i=1,klon |
|---|
| 90 | do l=1,klev |
|---|
| 91 | t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k) |
|---|
| 92 | enddo |
|---|
| 93 | enddo |
|---|
| 94 | write(str2,'(i2.2)') k |
|---|
| 95 | call histwrite_phy(nid_ins,.false.,"thv"//str2,itau_w,t_tauhvd) |
|---|
| 96 | enddo ! fin boucle NSPECV |
|---|
| 97 | |
|---|
| 98 | do k=8,NSPECI,10 |
|---|
| 99 | do i=1,klon |
|---|
| 100 | do l=1,klev |
|---|
| 101 | t_tauhvd(i,l)=TAUHID(i,klev-l+1,k) |
|---|
| 102 | enddo |
|---|
| 103 | enddo |
|---|
| 104 | write(str2,'(i2.2)') k |
|---|
| 105 | call histwrite_phy(nid_ins,.false.,"thi"//str2,itau_w,t_tauhvd) |
|---|
| 106 | enddo ! fin boucle NSPECI |
|---|
| 107 | c -------------- |
|---|
| 108 | c ----- EXTINCTION BRUME |
|---|
| 109 | do k=7,NSPECV,10 |
|---|
| 110 | do i=1,klon |
|---|
| 111 | do l=1,klev |
|---|
| 112 | if(l.ne.klev) |
|---|
| 113 | s t_khvd(i,l)=TAUHVD(i,klev-l+1,k) |
|---|
| 114 | s -TAUHVD(i,klev-l+1-1,k) |
|---|
| 115 | if(l.eq.klev) |
|---|
| 116 | s t_khvd(i,l)=TAUHVD(i,klev-l+1,k) |
|---|
| 117 | |
|---|
| 118 | t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) |
|---|
| 119 | enddo |
|---|
| 120 | enddo |
|---|
| 121 | write(str2,'(i2.2)') k |
|---|
| 122 | call histwrite_phy(nid_ins,.false.,"khv"//str2,itau_w,t_khvd) |
|---|
| 123 | enddo ! fin boucle NSPECV |
|---|
| 124 | |
|---|
| 125 | do k=8,NSPECI,10 |
|---|
| 126 | do i=1,klon |
|---|
| 127 | do l=1,klev |
|---|
| 128 | if(l.ne.klev) |
|---|
| 129 | s t_khvd(i,l)=TAUHID(i,klev-l+1,k) |
|---|
| 130 | s -TAUHID(i,klev-l+1-1,k) |
|---|
| 131 | if(l.eq.klev) |
|---|
| 132 | s t_khvd(i,l)=TAUHID(i,klev-l+1,k) |
|---|
| 133 | |
|---|
| 134 | t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) |
|---|
| 135 | enddo |
|---|
| 136 | enddo |
|---|
| 137 | write(str2,'(i2.2)') k |
|---|
| 138 | call histwrite_phy(nid_ins,.false.,"khi"//str2,itau_w,t_khvd) |
|---|
| 139 | enddo ! fin boucle NSPECI |
|---|
| 140 | c -------------- |
|---|
| 141 | c ----- OPACITE GAZ |
|---|
| 142 | do k=7,NSPECV,10 |
|---|
| 143 | do i=1,klon |
|---|
| 144 | do l=1,klev |
|---|
| 145 | t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k) |
|---|
| 146 | enddo |
|---|
| 147 | enddo |
|---|
| 148 | write(str2,'(i2.2)') k |
|---|
| 149 | call histwrite_phy(nid_ins,.false.,"tgv"//str2,itau_w,t_tauhvd) |
|---|
| 150 | enddo ! fin boucle NSPECV |
|---|
| 151 | |
|---|
| 152 | do k=8,NSPECI,10 |
|---|
| 153 | do i=1,klon |
|---|
| 154 | do l=1,klev |
|---|
| 155 | t_tauhvd(i,l)=TAUGID(i,klev-l+1,k) |
|---|
| 156 | enddo |
|---|
| 157 | enddo |
|---|
| 158 | write(str2,'(i2.2)') k |
|---|
| 159 | call histwrite_phy(nid_ins,.false.,"tgi"//str2,itau_w,t_tauhvd) |
|---|
| 160 | enddo ! fin boucle NSPECI |
|---|
| 161 | c -------------- |
|---|
| 162 | c ----- EXTINCTION GAZ |
|---|
| 163 | do k=7,NSPECV,10 |
|---|
| 164 | do i=1,klon |
|---|
| 165 | do l=1,klev |
|---|
| 166 | if(l.ne.klev) |
|---|
| 167 | s t_khvd(i,l)=TAUGVD(i,klev-l+1,k) |
|---|
| 168 | s -TAUGVD(i,klev-l+1-1,k) |
|---|
| 169 | if(l.eq.klev) |
|---|
| 170 | s t_khvd(i,l)=TAUGVD(i,klev-l+1,k) |
|---|
| 171 | |
|---|
| 172 | t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) |
|---|
| 173 | enddo |
|---|
| 174 | enddo |
|---|
| 175 | write(str2,'(i2.2)') k |
|---|
| 176 | call histwrite_phy(nid_ins,.false.,"kgv"//str2,itau_w,t_khvd) |
|---|
| 177 | enddo ! fin boucle NSPECV |
|---|
| 178 | |
|---|
| 179 | do k=8,NSPECI,10 |
|---|
| 180 | do i=1,klon |
|---|
| 181 | do l=1,klev |
|---|
| 182 | if(l.ne.klev) |
|---|
| 183 | s t_khvd(i,l)=TAUGID(i,klev-l+1,k) |
|---|
| 184 | s -TAUGID(i,klev-l+1-1,k) |
|---|
| 185 | |
|---|
| 186 | if(l.eq.klev) |
|---|
| 187 | s t_khvd(i,l)=TAUGID(i,klev-l+1,k) |
|---|
| 188 | |
|---|
| 189 | t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l)) |
|---|
| 190 | enddo |
|---|
| 191 | enddo |
|---|
| 192 | write(str2,'(i2.2)') k |
|---|
| 193 | call histwrite_phy(nid_ins,.false.,"kgi"//str2,itau_w,t_khvd) |
|---|
| 194 | enddo ! fin boucle NSPECI |
|---|
| 195 | |
|---|
| 196 | ENDIF !lev_histday.GE.3 |
|---|
| 197 | |
|---|
| 198 | c------------------------------------------------------- |
|---|
| 199 | IF(lev_histday.GE.4) THEN |
|---|
| 200 | |
|---|
| 201 | call histwrite_phy(nid_ins,.false.,"dtdyn",itau_w,d_t_dyn) |
|---|
| 202 | call histwrite_phy(nid_ins,.false.,"dtphy",itau_w,d_t) |
|---|
| 203 | c K/s |
|---|
| 204 | call histwrite_phy(nid_ins,.false.,"dtvdf",itau_w,d_t_vdf) |
|---|
| 205 | c K/s |
|---|
| 206 | call histwrite_phy(nid_ins,.false.,"dtajs",itau_w,d_t_ajs) |
|---|
| 207 | c K/s |
|---|
| 208 | call histwrite_phy(nid_ins,.false.,"dtswr",itau_w,heat) |
|---|
| 209 | c K/s |
|---|
| 210 | call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w,-1.*cool) |
|---|
| 211 | c K/s |
|---|
| 212 | c call histwrite_phy(nid_ins,.false.,"dtec",itau_w,d_t_ec) |
|---|
| 213 | c call histwrite_phy(nid_ins,.false.,"dvvdf",itau_w,d_v_vdf) |
|---|
| 214 | |
|---|
| 215 | ENDIF !lev_histday.GE.4 |
|---|
| 216 | |
|---|
| 217 | c------------------------------------------------------- |
|---|
| 218 | IF(lev_histday.GE.5) THEN |
|---|
| 219 | |
|---|
| 220 | c call histwrite_phy(nid_ins,.false.,"taux",itau_w,fluxu) |
|---|
| 221 | c call histwrite_phy(nid_ins,.false.,"tauy",itau_w,fluxv) |
|---|
| 222 | c call histwrite_phy(nid_ins,.false.,"cdrm",itau_w,cdragm) |
|---|
| 223 | c call histwrite_phy(nid_ins,.false.,"cdrh",itau_w,cdragh) |
|---|
| 224 | |
|---|
| 225 | ENDIF !lev_histday.GE.5 |
|---|
| 226 | c------------------------------------------------------- |
|---|
| 227 | |
|---|
| 228 | if (ok_sync) then |
|---|
| 229 | call histsync(nid_ins) |
|---|
| 230 | endif |
|---|
| 231 | ENDIF |
|---|
