Changeset 2025


Ignore:
Timestamp:
Apr 25, 2014, 7:58:33 PM (11 years ago)
Author:
fhourdin
Message:

Enrichissement des sorties pour le guidage
Enriched outputs for nudging

Location:
LMDZ5/trunk/libf
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3d/guide_mod.F90

    r2021 r2025  
    437437! Sauvegarde du guidage?
    438438    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    439     IF (f_out) CALL guide_out("S",jjp1,1,ps)
     439    IF (f_out) CALL guide_out("SP",jjp1,1,ps)
    440440   
    441441    if (guide_u) then
    … …  
    447447        if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
    448448        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
    449         IF (f_out) CALL guide_out("U",jjp1,llm,f_add/factt)
     449        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1+tau*ugui2)
     450        IF (f_out) CALL guide_out("u",jjp1,llm,ucov)
     451        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_add/factt)
    450452        ucov=ucov+f_add
    451453    endif
    … …  
    459461        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    460462        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
    461         IF (f_out) CALL guide_out("T",jjp1,llm,f_add/factt)
     463        IF (f_out) CALL guide_out("teta",jjp1,llm,f_add/factt)
    462464        teta=teta+f_add
    463465    endif
    … …  
    471473        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    472474        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    473         IF (f_out) CALL guide_out("P",jjp1,1,f_add(1:ip1jmp1,1)/factt)
     475        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
    474476        ps=ps+f_add(1:ip1jmp1,1)
    475477        CALL pression(ip1jmp1,ap,bp,ps,p)
    … …  
    485487        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    486488        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
    487         IF (f_out) CALL guide_out("Q",jjp1,llm,f_add/factt)
     489        IF (f_out) CALL guide_out("q",jjp1,llm,f_add/factt)
    488490        q=q+f_add
    489491    endif
    … …  
    497499        if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
    498500        CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
    499         IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:)/factt)
     501        IF (f_out) CALL guide_out("v",jjm,llm,vcov)
     502        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1+tau*vgui2)
     503        IF (f_out) CALL guide_out("vcov",jjm,llm,f_add(1:ip1jm,:)/factt)
    500504        vcov=vcov+f_add(1:ip1jm,:)
    501505    endif
    … …  
    15081512   
    15091513    ! Variables entree
    1510     CHARACTER, INTENT(IN)                          :: varname
     1514    CHARACTER*(*), INTENT(IN)                          :: varname
    15111515    INTEGER,   INTENT (IN)                         :: hsize,vsize
    15121516    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
    … …  
    15171521    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    15181522    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     1523    INTEGER       :: vid_au,vid_av
    15191524    INTEGER, DIMENSION (3) :: dim3
    15201525    INTEGER, DIMENSION (4) :: dim4,count,start
    1521     INTEGER                :: ierr, varid
     1526    INTEGER                :: ierr, varid,l
     1527    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    15221528
    15231529    print *,'Guide: output timestep',timestep,'var ',varname
    … …  
    15431549        ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
    15441550        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
     1551        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
    15451552        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
     1553        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
    15461554       
    15471555        ierr=NF_ENDDEF(nid)
    … …  
    15561564        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    15571565        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     1566        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u)
     1567        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v)
    15581568#else
    15591569        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    … …  
    15641574        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    15651575        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     1576        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     1577        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
    15661578#endif
    15671579! --------------------------------------------------------------------
    … …  
    15801592        IF (guide_u) THEN
    15811593            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
     1594            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
     1595            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
    15821596            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    15831597        ENDIF
    … …  
    15851599        IF (guide_v) THEN
    15861600            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
     1601            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
     1602            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
    15871603            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    15881604        ENDIF
    … …  
    16071623    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    16081624
     1625    IF (varname=="SP") timestep=timestep+1
     1626
     1627    ierr = NF_INQ_VARID(nid,varname,varid)
    16091628    SELECT CASE (varname)
    1610     CASE ("S")
    1611         timestep=timestep+1
    1612         ierr = NF_INQ_VARID(nid,"SP",varid)
     1629    CASE ("SP","ps")
    16131630        start=(/1,1,timestep,0/)
    16141631        count=(/iip1,jjp1,1,0/)
    1615 #ifdef NC_DOUBLE
    1616         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1617 #else
    1618         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1619 #endif
    1620     CASE ("P")
    1621         ierr = NF_INQ_VARID(nid,"ps",varid)
    1622         start=(/1,1,timestep,0/)
    1623         count=(/iip1,jjp1,1,0/)
    1624 #ifdef NC_DOUBLE
    1625         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1626 #else
    1627         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1628 #endif
    1629     CASE ("U")
    1630         ierr = NF_INQ_VARID(nid,"ucov",varid)
     1632    CASE ("v","va","vcov")
     1633        start=(/1,1,1,timestep/)
     1634        count=(/iip1,jjm,llm,1/)
     1635    CASE DEFAULT
    16311636        start=(/1,1,1,timestep/)
    16321637        count=(/iip1,jjp1,llm,1/)
     1638    END SELECT
     1639
     1640    SELECT CASE (varname)
     1641    CASE("u","ua")
     1642        DO l=1,llm ; field2(:,2:jjm,l)=field(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
     1643        field2(:,1,:)=0. ; field2(:,jjp1,:)=0.
     1644    CASE("v","va")
     1645        DO l=1,llm ; field2(:,:,l)=field(:,:,l)/cv(:,:) ; ENDDO
     1646    CASE DEFAULT
     1647        field2=field
     1648    END SELECT
     1649
     1650
    16331651#ifdef NC_DOUBLE
    1634         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
     1652    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
    16351653#else
    1636         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1654    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2)
    16371655#endif
    1638     CASE ("V")
    1639         ierr = NF_INQ_VARID(nid,"vcov",varid)
    1640         start=(/1,1,1,timestep/)
    1641         count=(/iip1,jjm,llm,1/)
    1642 #ifdef NC_DOUBLE
    1643         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1644 #else
    1645         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1646 #endif
    1647     CASE ("T")
    1648         ierr = NF_INQ_VARID(nid,"teta",varid)
    1649         start=(/1,1,1,timestep/)
    1650         count=(/iip1,jjp1,llm,1/)
    1651 #ifdef NC_DOUBLE
    1652         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1653 #else
    1654         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1655 #endif
    1656     CASE ("Q")
    1657         ierr = NF_INQ_VARID(nid,"q",varid)
    1658         start=(/1,1,1,timestep/)
    1659         count=(/iip1,jjp1,llm,1/)
    1660 #ifdef NC_DOUBLE
    1661         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1662 #else
    1663         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1664 #endif
    1665     END SELECT
    1666  
     1656
    16671657    ierr = NF_CLOSE(nid)
    16681658

  • LMDZ5/trunk/libf/dyn3dpar/guide_p_mod.F90

    r2021 r2025  
    492492    IF (f_out) THEN
    493493!       Calcul niveaux pression milieu de couches
    494         CALL pression_p( ip1jmp1, ap, bp, ps, p )
    495         if (pressure_exner) then
     494        CALL pression_p( ip1jmp1, ap, bp, ps, p )
     495        if (pressure_exner) then
    496496          CALL exner_hyb_p(ip1jmp1,ps,p,pks,pk)
    497         else
     497        else
    498498          CALL exner_milieu_p(ip1jmp1,ps,p,pks,pk)
    499499        endif
    500500        unskap=1./kappa
    501         DO l = 1, llm
    502             DO j=jjb_u,jje_u
    503                 DO i =1, iip1
    504                     p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    505                 ENDDO
    506             ENDDO
    507         ENDDO
    508         CALL guide_out("P",jjp1,llm,p(1:ip1jmp1,1:llm),1.)
     501        DO l = 1, llm
     502           DO j=jjb_u,jje_u
     503              DO i =1, iip1
     504                 p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     505              ENDDO
     506           ENDDO
     507        ENDDO
     508        CALL guide_out("SP",jjp1,llm,p(1:ip1jmp1,1:llm),1.)
    509509    ENDIF
    510510   
    … …  
    518518        if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
    519519        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
    520         IF (f_out) CALL guide_out("U",jjp1,llm,f_add(:,:),factt)
     520        IF (f_out) CALL guide_out("u",jjp1,llm,ucov,factt)
     521        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(:,:)+tau*ugui2(:,:),factt)
     522        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_add(:,:)/factt,factt)
    521523        ucov(ijb_u:ije_u,:)=ucov(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    522524    endif
    … …  
    530532        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    531533        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
    532         IF (f_out) CALL guide_out("T",jjp1,llm,f_add(:,:),factt)
     534        IF (f_out) CALL guide_out("teta",jjp1,llm,f_add(:,:)/factt,factt)
    533535        teta(ijb_u:ije_u,:)=teta(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    534536    endif
    … …  
    542544        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    543545        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    544         IF (f_out) CALL guide_out("SP",jjp1,1,f_add(1:ip1jmp1,1),factt)
     546        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt,factt)
    545547        ps(ijb_u:ije_u)=ps(ijb_u:ije_u)+f_add(ijb_u:ije_u,1)
    546548        CALL pression_p(ip1jmp1,ap,bp,ps,p)
    … …  
    556558        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    557559        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
    558         IF (f_out) CALL guide_out("Q",jjp1,llm,f_add(:,:),factt)
     560        IF (f_out) CALL guide_out("q",jjp1,llm,f_add(:,:)/factt,factt)
    559561        q(ijb_u:ije_u,:)=q(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    560562    endif
    … …  
    569571        if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
    570572        CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
    571         IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:),factt)
     573        IF (f_out) CALL guide_out("v",jjm,llm,vcov(1:ip1jm,:),factt)
     574        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(:,:)+tau*vgui2(:,:),factt)
     575        IF (f_out) CALL guide_out("vcov",jjm,llm,f_add(1:ip1jm,:)/factt,factt)
    572576        vcov(ijb_v:ije_v,:)=vcov(ijb_v:ije_v,:)+f_add(ijb_v:ije_v,:)
    573577    endif
    … …  
    786790    IF (guide_plevs.EQ.1) THEN
    787791        DO l=1,llm
    788             DO j=jjb_u,jje_u
    789                 DO i =1, iip1
     792            DO j=jjb_u,jje_u
     793                DO i =1, iip1
    790794                    pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
    791                 ENDDO
    792             ENDDO
     795                ENDDO
     796            ENDDO
    793797        ENDDO
    794798    ELSE
    795         CALL pression_p( ip1jmp1, ap, bp, psi, p )
    796         if (pressure_exner) then
     799        CALL pression_p( ip1jmp1, ap, bp, psi, p )
     800        if (pressure_exner) then
    797801          CALL exner_hyb_p(ip1jmp1,psi,p,pks,pk)
    798802        else
    799803          CALL exner_milieu_p(ip1jmp1,psi,p,pks,pk)
    800804        endif
    801         unskap=1./kappa
    802         DO l = 1, llm
    803             DO j=jjb_u,jje_u
    804                 DO i =1, iip1
    805                     pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    806                 ENDDO
    807             ENDDO
    808         ENDDO
     805        unskap=1./kappa
     806        DO l = 1, llm
     807            DO j=jjb_u,jje_u
     808                DO i =1, iip1
     809                    pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     810                ENDDO
     811            ENDDO
     812        ENDDO
    809813    ENDIF
    810814
    … …  
    10261030        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    10271031        IF (guide_plevs.EQ.1) THEN
    1028         CALL Register_SwapFieldHallo(psnat1,psnat1,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
    1029         CALL SendRequest(Req)
    1030         CALL WaitRequest(Req)
    1031         CALL Register_SwapFieldHallo(psnat2,psnat2,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
    1032         CALL SendRequest(Req)
    1033         CALL WaitRequest(Req)
     1032        CALL Register_SwapFieldHallo(psnat1,psnat1,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
     1033        CALL SendRequest(Req)
     1034        CALL WaitRequest(Req)
     1035        CALL Register_SwapFieldHallo(psnat2,psnat2,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
     1036        CALL SendRequest(Req)
     1037        CALL WaitRequest(Req)
    10341038            DO l=1,nlevnc
    10351039                DO j=jjb_v,jje_v
    … …  
    10431047            ENDDO
    10441048        ELSE IF (guide_plevs.EQ.2) THEN
    1045         CALL Register_SwapFieldHallo(pnat1,pnat1,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
    1046         CALL SendRequest(Req)
    1047         CALL WaitRequest(Req)
    1048         CALL Register_SwapFieldHallo(pnat2,pnat2,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
    1049         CALL SendRequest(Req)
    1050         CALL WaitRequest(Req)
     1049        CALL Register_SwapFieldHallo(pnat1,pnat1,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
     1050        CALL SendRequest(Req)
     1051        CALL WaitRequest(Req)
     1052        CALL Register_SwapFieldHallo(pnat2,pnat2,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
     1053        CALL SendRequest(Req)
     1054        CALL WaitRequest(Req)
    10511055            DO l=1,nlevnc
    10521056                DO j=jjb_v,jje_v
    … …  
    18091813   
    18101814    ! Variables entree
    1811     CHARACTER, INTENT(IN)                          :: varname
     1815    CHARACTER*(*), INTENT(IN)                          :: varname
    18121816    INTEGER,   INTENT (IN)                         :: hsize,vsize
    18131817    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
    … …  
    18191823    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    18201824    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     1825    INTEGER       :: vid_au,vid_av
     1826    INTEGER       :: l
    18211827    INTEGER, DIMENSION (3) :: dim3
    18221828    INTEGER, DIMENSION (4) :: dim4,count,start
    18231829    INTEGER                :: ierr, varid
     1830    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    18241831   
    18251832    CALL gather_field(field,iip1*hsize,vsize,0)
    … …  
    18361843! Definition des dimensions
    18371844        ierr=NF_DEF_DIM(nid,"LONU",iip1,id_lonu)
     1845        print*,'id_lonu 1 ',id_lonu
    18381846        ierr=NF_DEF_DIM(nid,"LONV",iip1,id_lonv)
    18391847        ierr=NF_DEF_DIM(nid,"LATU",jjp1,id_latu)
    … …  
    18441852! Creation des variables dimensions
    18451853        ierr=NF_DEF_VAR(nid,"LONU",NF_FLOAT,1,id_lonu,vid_lonu)
     1854        print*,'id_lonu 2 ',id_lonu
    18461855        ierr=NF_DEF_VAR(nid,"LONV",NF_FLOAT,1,id_lonv,vid_lonv)
    18471856        ierr=NF_DEF_VAR(nid,"LATU",NF_FLOAT,1,id_latu,vid_latu)
    … …  
    18501859        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
    18511860        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
     1861        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
     1862        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
    18521863       
    18531864        ierr=NF_ENDDEF(nid)
    … …  
    18551866! Enregistrement des variables dimensions
    18561867#ifdef NC_DOUBLE
     1868        print*,'id_lonu DOUBLE ',id_lonu,rlonu*180./pi
    18571869        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi)
    18581870        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi)
    … …  
    18621874        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    18631875        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     1876        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u)
     1877        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v)
    18641878#else
     1879        print*,'id_lonu 3 ',id_lonu,rlonu*180./pi
    18651880        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    18661881        ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi)
    … …  
    18701885        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    18711886        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     1887        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     1888        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
    18721889#endif
    18731890! --------------------------------------------------------------------
    … …  
    18771894! Pressure (GCM)
    18781895        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
    1879         ierr = NF_DEF_VAR(nid,"P",NF_FLOAT,4,dim4,varid)
     1896        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
    18801897! Surface pressure (guidage)
    18811898        IF (guide_P) THEN
    … …  
    18851902! Zonal wind
    18861903        IF (guide_u) THEN
     1904        print*,'id_lonu 4 ',id_lonu,varname
    18871905            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
     1906            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
     1907            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
    18881908            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    18891909        ENDIF
    … …  
    18911911        IF (guide_v) THEN
    18921912            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
     1913            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
     1914            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
    18931915            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    18941916        ENDIF
    … …  
    19141936    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    19151937
     1938    IF (varname=="SP") timestep=timestep+1
     1939
     1940    IF (varname=="SP") THEN
     1941      print*,'varname=SP=',varname
     1942    ELSE
     1943      print*,'varname diff SP=',varname
     1944    ENDIF
     1945
     1946
     1947    ierr = NF_INQ_VARID(nid,varname,varid)
    19161948    SELECT CASE (varname)
    1917     CASE ("P")
    1918         timestep=timestep+1
    1919         ierr = NF_INQ_VARID(nid,"P",varid)
     1949    CASE ("SP","ps")
    19201950        start=(/1,1,1,timestep/)
    19211951        count=(/iip1,jjp1,llm,1/)
    1922 #ifdef NC_DOUBLE
    1923         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1924 #else
    1925         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1926 #endif
    1927     CASE ("SP")
    1928         ierr = NF_INQ_VARID(nid,"ps",varid)
    1929         start=(/1,1,timestep,0/)
    1930         count=(/iip1,jjp1,1,0/)
    1931 #ifdef NC_DOUBLE
    1932         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1933 #else
    1934         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1935 #endif
    1936     CASE ("U")
    1937         ierr = NF_INQ_VARID(nid,"ucov",varid)
     1952    CASE ("v","va","vcov")
     1953        start=(/1,1,1,timestep/)
     1954        count=(/iip1,jjm,llm,1/)
     1955    CASE DEFAULT
    19381956        start=(/1,1,1,timestep/)
    19391957        count=(/iip1,jjp1,llm,1/)
     1958    END SELECT
     1959
     1960    SELECT CASE (varname)
     1961    CASE("u","ua")
     1962        DO l=1,llm ; field2(:,2:jjm,l)=field(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
     1963        field2(:,1,:)=0. ; field2(:,jjp1,:)=0.
     1964    CASE("v","va")
     1965        DO l=1,llm ; field2(:,:,l)=field(:,:,l)/cv(:,:) ; ENDDO
     1966    CASE DEFAULT
     1967        field2=field
     1968    END SELECT
     1969
    19401970#ifdef NC_DOUBLE
    1941         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     1971    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
    19421972#else
    1943         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
     1973    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2)
    19441974#endif
    1945     CASE ("V")
    1946         ierr = NF_INQ_VARID(nid,"vcov",varid)
    1947         start=(/1,1,1,timestep/)
    1948         count=(/iip1,jjm,llm,1/)
    1949 #ifdef NC_DOUBLE
    1950         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1951 #else
    1952         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1953 #endif
    1954     CASE ("T")
    1955         ierr = NF_INQ_VARID(nid,"teta",varid)
    1956         start=(/1,1,1,timestep/)
    1957         count=(/iip1,jjp1,llm,1/)
    1958 #ifdef NC_DOUBLE
    1959         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1960 #else
    1961         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1962 #endif
    1963     CASE ("Q")
    1964         ierr = NF_INQ_VARID(nid,"q",varid)
    1965         start=(/1,1,1,timestep/)
    1966         count=(/iip1,jjp1,llm,1/)
    1967 #ifdef NC_DOUBLE
    1968         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1969 #else
    1970         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1971 #endif
    1972     END SELECT
    19731975 
    19741976    ierr = NF_CLOSE(nid)
Note: See TracChangeset for help on using the changeset viewer.