*=*=*=*= writeavs.html =*=*=*=*
SUBROUTINE writeavs(nq,pdtav,ptime,pu,pv,ph,pq,pp,ifin) IMPLICIT NONE c auteur : L.Fairhead c======================================================================= c c Ecriture des moyennes diurnes c On ecrit la moyenne tous les jours c si ifin NE 0 on ecrit la moyenne et on ferme le fichier histoire c c======================================================================= c Declarations: c ------------- #include "dimensions.h" #include "paramet.h" #include "comav.h" #include "comvert.h" #include "comconst.h" #include "comgeom.h" #include "description.h" c argusments: c ---------- INTEGER itau,nq REAL pdtav REAL pu(ip1jmp1*llm),pv(ip1jm*llm),ph(ip1jmp1*llm) REAL pq(ip1jmp1*llm,nq) REAL pp(ip1jmp1) REAL ztime,ptime c local: c ------ INTEGER idaym,idayp,i,ifin,l,iq INTEGER*4 iday,isec REAL zdtm,zdtp,dttot REAL zw,zwtot,zz REAL ztimem,ztimep,zdtime REAL um(ip1jmp1*llm),vm(ip1jm*llm),hm(ip1jmp1*llm) real us(ip1jmp1,llm),vs(ip1jmp1,llm) REAL qm(ip1jmp1*llm,nqmx) REAL pm(ip1jmp1),zpks(ip1jmp1) LOGICAL firstcal SAVE idaym SAVE um,vm,hm,qm,pm,dttot SAVE firstcal DATA firstcal/.true./ INTEGER ierr INTEGER setname, cluvdb, setvdim, putdat, cllun, putvdim REAL time INTEGER it1, it2 character str2*2,str3*3 c EXTERNAL exner_new c----------------------------------------------------------------------- c calcul de la position par rapport aux jours pleins: c --------------------------------------------------- IF(firstcal) THEN zz=-time0_av/period_av idaym=INT(zz) IF(zz.LT.0.) idaym=idaym-1 dttot=0. CALL initial0(ijp1llm,um) CALL initial0(ijmllm,vm) CALL initial0(ijp1llm,hm) IF(nq.GT.0) CALL initial0(ijp1llm*nq,qm) CALL initial0(ip1jmp1,pm) IF(nq.GT.nqmx) THEN PRINT*,'Il faut augmenter nqmx dans writeav.f' ENDIF ENDIF ztime=ptime-time0_av zdtime=pdtav IF(firstcal) THEN c ztimem=ztime c zdtime=pdtav*.5+ztime-time0_av ztimem = 0. ELSE ztimem=ztime-.5*pdtav ENDIF firstcal=.false. IF(ifin.EQ.0) THEN ztimep=ztime+.5*pdtav ELSE ztimep=ztime c zdtime=pdtav*.5 ENDIF zdtime = ztimep-ztimem zz=ztimep/period_av idayp=INT(zz) IF(zz.LT.0.) idayp=idayp-1 C PRINT*,period_av,ptime,ztime,idaym,idayp c----------------------------------------------------------------------- c premier cas: on ne change pas de jour: c -------------------------------------- IF(idaym.EQ.idayp) THEN DO i=1,ijp1llm um(i)=um(i)+pu(i) hm(i)=hm(i)+ph(i) ENDDO IF(nq.GT.0) THEN DO iq=1,nq DO i=1,ijp1llm qm(i,iq)=qm(i,iq)+pq(i,iq) ENDDO ENDDO ENDIF DO i=1,ijmllm vm(i)=vm(i)+pv(i) ENDDO DO i=1,ip1jmp1 pm(i)=pm(i)+pp(i) ENDDO c dttot=dttot+pdtav dttot=dttot + (ztimep - ztimem) c----------------------------------------------------------------------- c deuxieme cas: on change de jour dans dtav: c ------------------------------------------ ELSE zdtp=ztimep-FLOAT(idayp)*period_av zdtm=zdtime-zdtp c ajout partiel sur le jour precedent: c ------------------------------------ dttot=dttot+zdtm IF(dttot.GT.period_av*1.e-5) THEN zwtot=pdtav/dttot zw=zdtm/pdtav DO i=1,ijp1llm um(i)=(um(i)+pu(i)*zw)*zwtot hm(i)=(hm(i)+ph(i)*zw)*zwtot ENDDO IF (nq.GT.0) THEN DO iq=1,nq DO i=1,ijp1llm qm(i,iq)=(qm(i,iq)+pq(i,iq)*zw)*zwtot ENDDO ENDDO ENDIF DO i=1,ijmllm vm(i)=(vm(i)+pv(i)*zw)*zwtot ENDDO DO i=1,ip1jmp1 pm(i)=(pm(i)+pp(i)*zw)*zwtot ENDDO c ecriture du fichier de moyenne: c ------------------------------- c transformation en variables naturelles: c --------------------------------------- CALL covnat(llm,um,vm,um,vm) c c ...... P. Le Van ( modif le 17/04/96 ) ...... c CALL exner_new(ip1jmp1,pm,.TRUE.,zpks,zpks) CALL multscal(ijp1llm,hm,1./cpp,hm) DO l=1,llm CALL multipl(ip1jmp1,hm((l-1)*ip1jmp1+1), s zpks,hm((l-1)*ip1jmp1+1)) CALL multscal(ip1jmp1,hm((l-1)*ip1jmp1+1), s s(l),hm((l-1)*ip1jmp1+1)) ENDDO CALL multipl(ip1jmp1,pm,unsaire,pm) c Ecriture/extension de la coordonnee temps ierr = CLUVDB() ierr = SETNAME(descript,'temps','temps simule', . 'jours',' ') time = FLOAT(idayp)*period_av-.5*dttot print *,'time= ',time print*,'unitav = ',unitav ierr = PUTVDIM(unitav,1,time,it1,it2) C on passe le vent sur la grille scalaire call gr_u_scal(llm,um,us) call gr_v_scal(llm,vm,vs) C Ecriture des champs print*,'Ecriture dans writeavs' ierr = CLUVDB() c ierr = SETVDIM(1,' ','temps',' ',' ',time,time) c ierr = SETNAME(descript,'dttot','periode moyennee',' ',' ') c ierr = PUTDAT(unitav,dttot) ierr = CLUVDB() ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1)) ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1)) ierr = SETVDIM(3,' ','sig_s',' ',' ',sig_s(1),sig_s(llm)) ierr = SETVDIM(4,' ','temps',' ',' ',time,time) ierr = SETNAME(descript,'u', . 'vents u naturels moyennees','m/s',' ') ierr = PUTDAT(unitav,us) ierr = SETNAME(descript,'v', . 'vents v naturels moyennes','m/s',' ') ierr = PUTDAT(unitav,vs) ierr = SETNAME(descript,'T', . 'temperature moyennees','K',' ') ierr = PUTDAT(unitav,hm) IF(nq.GT.0) THEN DO iq=1,nq str2(1:1)='q' if(iq.le.9) then str2(1:1)='q' WRITE(str2(2:2),'(i1.1)') iq ierr = setname(descript,str2,'traceur',' ',' ') print*,'On ecrit la variable iq=',iq,' =',str2 else str3(1:1)='q' WRITE(str3(2:3),'(i2.2)') iq ierr = setname(descript,str3,'traceur',' ',' ') print*,'On ecrit la variable iq=',iq,' =',str3 endif ierr = PUTDAT(unitav,qm(1,iq)) ENDDO ENDIF ierr = CLUVDB() ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1)) ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1)) ierr = SETVDIM(3,' ','temps',' ',' ',time,time) ierr = SETNAME(descript,'ps', . 'pression extensive moyennee','Pa',' ') ierr = PUTDAT(unitav,pm) ENDIF c ajout partiel sur le jour suivant: c ---------------------------------- dttot=zdtp c PRINT*,'dttot=zdtp',dttot zw=zdtp/pdtav DO i=1,ijp1llm um(i)=pu(i)*zw hm(i)=ph(i)*zw ENDDO c IF (nq.GT.0) THEN DO iq=1,nq DO i=1,ijp1llm c c .... P. Le Van ( modif le 30/12/96 ) ...... qm(i,iq) = pq(i,iq) * zw ENDDO ENDDO ENDIF c DO i=1,ijmllm vm(i)=pv(i)*zw ENDDO DO i=1,ip1jmp1 pm(i)=pp(i)*zw ENDDO ENDIF idaym=idayp c----------------------------------------------------------------------- c ecriture en fin de run et fermeture du fichier: c ----------------------------------------------- IF(ifin.NE.0) THEN c si un temps non negligeable s'est ecoule depuis la derniere ecriture c on sauvegarde le champ supplementaire PRINT*,'dttot 4',dttot IF(dttot.GT.1.e-5*period_av) THEN PRINT*,'dttot 4b',dttot zwtot=pdtav/dttot DO i=1,ijp1llm um(i)= um(i)*zwtot hm(i)= hm(i)*zwtot ENDDO c .... P.Le Van ( ajout le 30/12/96 ) ....... c IF (nq.GT.0) THEN DO iq=1,nq DO i=1,ijp1llm qm(i,iq)= qm(i,iq)*zwtot ENDDO ENDDO ENDIF c ............................................. DO i=1,ijmllm vm(i)= vm(i)*zwtot ENDDO DO i=1,ip1jmp1 pm(i)= pm(i)*zwtot ENDDO CALL covnat(llm,um,vm,um,vm) c c .......... P.Le Van ( Modif le 22/12/95 ) ........... c ......... et le 17/04/96 .......... c CALL exner_new(ip1jmp1,pm,.TRUE.,zpks,zpks) CALL multscal(ijp1llm,hm,1./cpp,hm) DO l=1,llm CALL multipl(ip1jmp1,hm((l-1)*ip1jmp1+1), s zpks,hm((l-1)*ip1jmp1+1)) CALL multscal(ip1jmp1,hm((l-1)*ip1jmp1+1), s s(l),hm((l-1)*ip1jmp1+1)) ENDDO c ................................................................ c CALL multipl(ip1jmp1,pm,unsaire,pm) c Ecriture/extension de la coordonnee temps ierr = CLUVDB() ierr = SETNAME(descript,'temps','temps simule','jours',' ') time = FLOAT(idayp)*period_av-.5*dttot print *,'time= ',time ierr = PUTVDIM(unitav,1,time,it1,it2) C on passe le vent sur la grille scalaire call gr_u_scal(llm,um,us) call gr_v_scal(llm,vm,vs) C Ecriture des champs print*,'Ecriture dans writeavs' ierr = CLUVDB() ierr = SETVDIM(1,' ','temps',' ',' ',time,time) ierr = SETNAME(descript,'dttot','periode moyennee',' ',' ') ierr = PUTDAT(unitav,dttot) ierr = CLUVDB() ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1)) ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1)) ierr = SETVDIM(3,' ','sig_s',' ',' ',sig_s(1),sig_s(llm)) ierr = SETVDIM(4,' ','temps',' ',' ',time,time) ierr = SETNAME(descript,'u', . 'vents u naturels moyennees','m/s',' ') ierr = PUTDAT(unitav,us) ierr = SETNAME(descript,'v','vents v naturels moyennes' . ,'m/s',' ') ierr = PUTDAT(unitav,vs) ierr = SETNAME(descript,'T', . 'temperature moyennees','K',' ') ierr = PUTDAT(unitav,hm) c c .... P. Le Van ( ajout le 30/12/96 ) .... c IF(nq.GT.0) THEN DO iq=1,nq str2(1:1)='q' if(iq.le.9) then str2(1:1)='q' WRITE(str2(2:2),'(i1.1)') iq ierr = setname(descript,str2,'traceur',' ',' ') print*,'On ecrit la variable iq=',iq,' =',str2 else str3(1:1)='q' WRITE(str3(2:3),'(i2.2)') iq ierr = setname(descript,str3,'traceur',' ',' ') print*,'On ecrit la variable iq=',iq,' =',str3 endif ierr = PUTDAT(unitav,qm(1,iq)) ENDDO ENDIF c ierr = CLUVDB() ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1)) ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1)) ierr = SETVDIM(3,' ','temps',' ',' ',time,time) ierr = SETNAME(descript,'ps','pression extensive moyennee' . ,'Pa',' ') ierr = PUTDAT(unitav,pm) ENDIF c CLOSE(unitav) C ierr = CLLUN(unitav) RETURN ENDIF RETURN END