Changeset 2024


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

Enrichissement des sorties du guidage
Enriched outputs for nudging

Location:
LMDZ5/branches/testing/libf
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing/libf/dyn3d/guide_mod.F90

    r1910 r2024  
    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
    … …  
    15071511   
    15081512    ! Variables entree
    1509     CHARACTER, INTENT(IN)                          :: varname
     1513    CHARACTER*(*), INTENT(IN)                          :: varname
    15101514    INTEGER,   INTENT (IN)                         :: hsize,vsize
    15111515    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
    … …  
    15161520    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    15171521    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     1522    INTEGER       :: vid_au,vid_av
    15181523    INTEGER, DIMENSION (3) :: dim3
    15191524    INTEGER, DIMENSION (4) :: dim4,count,start
    1520     INTEGER                :: ierr, varid
     1525    INTEGER                :: ierr, varid,l
     1526    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    15211527
    15221528    print *,'Guide: output timestep',timestep,'var ',varname
    … …  
    15421548        ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
    15431549        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
     1550        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
    15441551        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
     1552        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
    15451553       
    15461554        ierr=NF_ENDDEF(nid)
    … …  
    15551563        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    15561564        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     1565        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u)
     1566        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v)
    15571567#else
    15581568        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    … …  
    15631573        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    15641574        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     1575        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     1576        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
    15651577#endif
    15661578! --------------------------------------------------------------------
    … …  
    15791591        IF (guide_u) THEN
    15801592            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
     1593            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
     1594            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
    15811595            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    15821596        ENDIF
    … …  
    15841598        IF (guide_v) THEN
    15851599            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
     1600            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
     1601            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
    15861602            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    15871603        ENDIF
    … …  
    16061622    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    16071623
     1624    IF (varname=="SP") timestep=timestep+1
     1625
     1626    ierr = NF_INQ_VARID(nid,varname,varid)
    16081627    SELECT CASE (varname)
    1609     CASE ("S")
    1610         timestep=timestep+1
    1611         ierr = NF_INQ_VARID(nid,"SP",varid)
     1628    CASE ("SP","ps")
    16121629        start=(/1,1,timestep,0/)
    16131630        count=(/iip1,jjp1,1,0/)
    1614 #ifdef NC_DOUBLE
    1615         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1616 #else
    1617         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1618 #endif
    1619     CASE ("P")
    1620         ierr = NF_INQ_VARID(nid,"ps",varid)
    1621         start=(/1,1,timestep,0/)
    1622         count=(/iip1,jjp1,1,0/)
    1623 #ifdef NC_DOUBLE
    1624         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1625 #else
    1626         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1627 #endif
    1628     CASE ("U")
    1629         ierr = NF_INQ_VARID(nid,"ucov",varid)
     1631    CASE ("v","va","vcov")
     1632        start=(/1,1,1,timestep/)
     1633        count=(/iip1,jjm,llm,1/)
     1634    CASE DEFAULT
    16301635        start=(/1,1,1,timestep/)
    16311636        count=(/iip1,jjp1,llm,1/)
     1637    END SELECT
     1638
     1639    SELECT CASE (varname)
     1640    CASE("u","ua")
     1641        DO l=1,llm ; field2(:,2:jjm,l)=field(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
     1642        field2(:,1,:)=0. ; field2(:,jjp1,:)=0.
     1643    CASE("v","va")
     1644        DO l=1,llm ; field2(:,:,l)=field(:,:,l)/cv(:,:) ; ENDDO
     1645    CASE DEFAULT
     1646        field2=field
     1647    END SELECT
     1648
     1649
    16321650#ifdef NC_DOUBLE
    1633         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
     1651    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
    16341652#else
    1635         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1653    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2)
    16361654#endif
    1637     CASE ("V")
    1638         ierr = NF_INQ_VARID(nid,"vcov",varid)
    1639         start=(/1,1,1,timestep/)
    1640         count=(/iip1,jjm,llm,1/)
    1641 #ifdef NC_DOUBLE
    1642         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1643 #else
    1644         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1645 #endif
    1646     CASE ("T")
    1647         ierr = NF_INQ_VARID(nid,"teta",varid)
    1648         start=(/1,1,1,timestep/)
    1649         count=(/iip1,jjp1,llm,1/)
    1650 #ifdef NC_DOUBLE
    1651         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1652 #else
    1653         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1654 #endif
    1655     CASE ("Q")
    1656         ierr = NF_INQ_VARID(nid,"q",varid)
    1657         start=(/1,1,1,timestep/)
    1658         count=(/iip1,jjp1,llm,1/)
    1659 #ifdef NC_DOUBLE
    1660         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1661 #else
    1662         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1663 #endif
    1664     END SELECT
    1665  
     1655
    16661656    ierr = NF_CLOSE(nid)
    16671657

  • LMDZ5/branches/testing/libf/dyn3dpar/guide_p_mod.F90

    r1910 r2024  
    491491    IF (f_out) THEN
    492492!       Calcul niveaux pression milieu de couches
    493         CALL pression_p( ip1jmp1, ap, bp, ps, p )
    494         if (pressure_exner) then
     493        CALL pression_p( ip1jmp1, ap, bp, ps, p )
     494        if (pressure_exner) then
    495495          CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
    496         else
     496        else
    497497          CALL exner_milieu_p(ip1jmp1,ps,p,beta,pks,pk,pkf)
    498498        endif
    499499        unskap=1./kappa
    500         DO l = 1, llm
    501             DO j=jjb_u,jje_u
    502                 DO i =1, iip1
    503                     p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    504                 ENDDO
    505             ENDDO
    506         ENDDO
    507         CALL guide_out("P",jjp1,llm,p(1:ip1jmp1,1:llm),1.)
     500        DO l = 1, llm
     501           DO j=jjb_u,jje_u
     502              DO i =1, iip1
     503                 p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     504              ENDDO
     505           ENDDO
     506        ENDDO
     507        CALL guide_out("SP",jjp1,llm,p(1:ip1jmp1,1:llm),1.)
    508508    ENDIF
    509509   
    … …  
    517517        if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
    518518        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
    519         IF (f_out) CALL guide_out("U",jjp1,llm,f_add(:,:),factt)
     519        IF (f_out) CALL guide_out("u",jjp1,llm,ucov,factt)
     520        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(:,:)+tau*ugui2(:,:),factt)
     521        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_add(:,:)/factt,factt)
    520522        ucov(ijb_u:ije_u,:)=ucov(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    521523    endif
    … …  
    529531        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    530532        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
    531         IF (f_out) CALL guide_out("T",jjp1,llm,f_add(:,:),factt)
     533        IF (f_out) CALL guide_out("teta",jjp1,llm,f_add(:,:)/factt,factt)
    532534        teta(ijb_u:ije_u,:)=teta(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    533535    endif
    … …  
    541543        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    542544        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    543         IF (f_out) CALL guide_out("SP",jjp1,1,f_add(1:ip1jmp1,1),factt)
     545        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt,factt)
    544546        ps(ijb_u:ije_u)=ps(ijb_u:ije_u)+f_add(ijb_u:ije_u,1)
    545547        CALL pression_p(ip1jmp1,ap,bp,ps,p)
    … …  
    555557        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    556558        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
    557         IF (f_out) CALL guide_out("Q",jjp1,llm,f_add(:,:),factt)
     559        IF (f_out) CALL guide_out("q",jjp1,llm,f_add(:,:)/factt,factt)
    558560        q(ijb_u:ije_u,:)=q(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    559561    endif
    … …  
    568570        if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
    569571        CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
    570         IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:),factt)
     572        IF (f_out) CALL guide_out("v",jjm,llm,vcov(1:ip1jm,:),factt)
     573        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(:,:)+tau*vgui2(:,:),factt)
     574        IF (f_out) CALL guide_out("vcov",jjm,llm,f_add(1:ip1jm,:)/factt,factt)
    571575        vcov(ijb_v:ije_v,:)=vcov(ijb_v:ije_v,:)+f_add(ijb_v:ije_v,:)
    572576    endif
    … …  
    784788    IF (guide_plevs.EQ.1) THEN
    785789        DO l=1,llm
    786             DO j=jjb_u,jje_u
    787                 DO i =1, iip1
     790            DO j=jjb_u,jje_u
     791                DO i =1, iip1
    788792                    pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
    789                 ENDDO
    790             ENDDO
     793                ENDDO
     794            ENDDO
    791795        ENDDO
    792796    ELSE
    793         CALL pression_p( ip1jmp1, ap, bp, psi, p )
    794         if (pressure_exner) then
     797        CALL pression_p( ip1jmp1, ap, bp, psi, p )
     798        if (pressure_exner) then
    795799          CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
    796800        else
    797801          CALL exner_milieu_p(ip1jmp1,psi,p,beta,pks,pk,pkf)
    798802        endif
    799         unskap=1./kappa
    800         DO l = 1, llm
    801             DO j=jjb_u,jje_u
    802                 DO i =1, iip1
    803                     pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    804                 ENDDO
    805             ENDDO
    806         ENDDO
     803        unskap=1./kappa
     804        DO l = 1, llm
     805            DO j=jjb_u,jje_u
     806                DO i =1, iip1
     807                    pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     808                ENDDO
     809            ENDDO
     810        ENDDO
    807811    ENDIF
    808812
    … …  
    10241028        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    10251029        IF (guide_plevs.EQ.1) THEN
    1026         CALL Register_SwapFieldHallo(psnat1,psnat1,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
    1027         CALL SendRequest(Req)
    1028         CALL WaitRequest(Req)
    1029         CALL Register_SwapFieldHallo(psnat2,psnat2,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
    1030         CALL SendRequest(Req)
    1031         CALL WaitRequest(Req)
     1030        CALL Register_SwapFieldHallo(psnat1,psnat1,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
     1031        CALL SendRequest(Req)
     1032        CALL WaitRequest(Req)
     1033        CALL Register_SwapFieldHallo(psnat2,psnat2,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
     1034        CALL SendRequest(Req)
     1035        CALL WaitRequest(Req)
    10321036            DO l=1,nlevnc
    10331037                DO j=jjb_v,jje_v
    … …  
    10411045            ENDDO
    10421046        ELSE IF (guide_plevs.EQ.2) THEN
    1043         CALL Register_SwapFieldHallo(pnat1,pnat1,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
    1044         CALL SendRequest(Req)
    1045         CALL WaitRequest(Req)
    1046         CALL Register_SwapFieldHallo(pnat2,pnat2,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
    1047         CALL SendRequest(Req)
    1048         CALL WaitRequest(Req)
     1047        CALL Register_SwapFieldHallo(pnat1,pnat1,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
     1048        CALL SendRequest(Req)
     1049        CALL WaitRequest(Req)
     1050        CALL Register_SwapFieldHallo(pnat2,pnat2,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
     1051        CALL SendRequest(Req)
     1052        CALL WaitRequest(Req)
    10491053            DO l=1,nlevnc
    10501054                DO j=jjb_v,jje_v
    … …  
    18071811   
    18081812    ! Variables entree
    1809     CHARACTER, INTENT(IN)                          :: varname
     1813    CHARACTER*(*), INTENT(IN)                          :: varname
    18101814    INTEGER,   INTENT (IN)                         :: hsize,vsize
    18111815    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
    … …  
    18171821    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    18181822    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     1823    INTEGER       :: vid_au,vid_av
     1824    INTEGER       :: l
    18191825    INTEGER, DIMENSION (3) :: dim3
    18201826    INTEGER, DIMENSION (4) :: dim4,count,start
    18211827    INTEGER                :: ierr, varid
     1828    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    18221829   
    18231830    CALL gather_field(field,iip1*hsize,vsize,0)
    … …  
    18341841! Definition des dimensions
    18351842        ierr=NF_DEF_DIM(nid,"LONU",iip1,id_lonu)
     1843        print*,'id_lonu 1 ',id_lonu
    18361844        ierr=NF_DEF_DIM(nid,"LONV",iip1,id_lonv)
    18371845        ierr=NF_DEF_DIM(nid,"LATU",jjp1,id_latu)
    … …  
    18421850! Creation des variables dimensions
    18431851        ierr=NF_DEF_VAR(nid,"LONU",NF_FLOAT,1,id_lonu,vid_lonu)
     1852        print*,'id_lonu 2 ',id_lonu
    18441853        ierr=NF_DEF_VAR(nid,"LONV",NF_FLOAT,1,id_lonv,vid_lonv)
    18451854        ierr=NF_DEF_VAR(nid,"LATU",NF_FLOAT,1,id_latu,vid_latu)
    … …  
    18481857        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
    18491858        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
     1859        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
     1860        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
    18501861       
    18511862        ierr=NF_ENDDEF(nid)
    … …  
    18531864! Enregistrement des variables dimensions
    18541865#ifdef NC_DOUBLE
     1866        print*,'id_lonu DOUBLE ',id_lonu,rlonu*180./pi
    18551867        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi)
    18561868        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi)
    … …  
    18601872        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    18611873        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     1874        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u)
     1875        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v)
    18621876#else
     1877        print*,'id_lonu 3 ',id_lonu,rlonu*180./pi
    18631878        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    18641879        ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi)
    … …  
    18681883        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    18691884        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     1885        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     1886        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
    18701887#endif
    18711888! --------------------------------------------------------------------
    … …  
    18751892! Pressure (GCM)
    18761893        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
    1877         ierr = NF_DEF_VAR(nid,"P",NF_FLOAT,4,dim4,varid)
     1894        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
    18781895! Surface pressure (guidage)
    18791896        IF (guide_P) THEN
    … …  
    18831900! Zonal wind
    18841901        IF (guide_u) THEN
     1902        print*,'id_lonu 4 ',id_lonu,varname
    18851903            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
     1904            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
     1905            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
    18861906            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    18871907        ENDIF
    … …  
    18891909        IF (guide_v) THEN
    18901910            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
     1911            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
     1912            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
    18911913            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    18921914        ENDIF
    … …  
    19121934    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    19131935
     1936    IF (varname=="SP") timestep=timestep+1
     1937
     1938    IF (varname=="SP") THEN
     1939      print*,'varname=SP=',varname
     1940    ELSE
     1941      print*,'varname diff SP=',varname
     1942    ENDIF
     1943
     1944
     1945    ierr = NF_INQ_VARID(nid,varname,varid)
    19141946    SELECT CASE (varname)
    1915     CASE ("P")
    1916         timestep=timestep+1
    1917         ierr = NF_INQ_VARID(nid,"P",varid)
     1947    CASE ("SP","ps")
    19181948        start=(/1,1,1,timestep/)
    19191949        count=(/iip1,jjp1,llm,1/)
    1920 #ifdef NC_DOUBLE
    1921         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1922 #else
    1923         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1924 #endif
    1925     CASE ("SP")
    1926         ierr = NF_INQ_VARID(nid,"ps",varid)
    1927         start=(/1,1,timestep,0/)
    1928         count=(/iip1,jjp1,1,0/)
    1929 #ifdef NC_DOUBLE
    1930         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1931 #else
    1932         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1933 #endif
    1934     CASE ("U")
    1935         ierr = NF_INQ_VARID(nid,"ucov",varid)
     1950    CASE ("v","va","vcov")
     1951        start=(/1,1,1,timestep/)
     1952        count=(/iip1,jjm,llm,1/)
     1953    CASE DEFAULT
    19361954        start=(/1,1,1,timestep/)
    19371955        count=(/iip1,jjp1,llm,1/)
     1956    END SELECT
     1957
     1958    SELECT CASE (varname)
     1959    CASE("u","ua")
     1960        DO l=1,llm ; field2(:,2:jjm,l)=field(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
     1961        field2(:,1,:)=0. ; field2(:,jjp1,:)=0.
     1962    CASE("v","va")
     1963        DO l=1,llm ; field2(:,:,l)=field(:,:,l)/cv(:,:) ; ENDDO
     1964    CASE DEFAULT
     1965        field2=field
     1966    END SELECT
     1967
    19381968#ifdef NC_DOUBLE
    1939         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     1969    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
    19401970#else
    1941         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
     1971    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2)
    19421972#endif
    1943     CASE ("V")
    1944         ierr = NF_INQ_VARID(nid,"vcov",varid)
    1945         start=(/1,1,1,timestep/)
    1946         count=(/iip1,jjm,llm,1/)
    1947 #ifdef NC_DOUBLE
    1948         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1949 #else
    1950         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1951 #endif
    1952     CASE ("T")
    1953         ierr = NF_INQ_VARID(nid,"teta",varid)
    1954         start=(/1,1,1,timestep/)
    1955         count=(/iip1,jjp1,llm,1/)
    1956 #ifdef NC_DOUBLE
    1957         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1958 #else
    1959         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1960 #endif
    1961     CASE ("Q")
    1962         ierr = NF_INQ_VARID(nid,"q",varid)
    1963         start=(/1,1,1,timestep/)
    1964         count=(/iip1,jjp1,llm,1/)
    1965 #ifdef NC_DOUBLE
    1966         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    1967 #else
    1968         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    1969 #endif
    1970     END SELECT
    19711973 
    19721974    ierr = NF_CLOSE(nid)
Note: See TracChangeset for help on using the changeset viewer.