Changeset 2028


Ignore:
Timestamp:
Apr 30, 2014, 4:14:49 AM (10 years ago)
Author:
fhourdin
Message:

Correction d'un bug sur les sorties du guidage dans dyn3dmem + enrichissement
des sorties.
Bug fixing in nudging outputs in dyn3dmem + enriched outputs

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3dmem/guide_loc_mod.F90

    r2021 r2028  
    535535    IF (f_out) THEN
    536536!       Calcul niveaux pression milieu de couches
    537         CALL pression_loc( ijnb_u, ap, bp, ps, p )
    538         if (pressure_exner) then
     537        CALL pression_loc( ijnb_u, ap, bp, ps, p )
     538        if (pressure_exner) then
    539539          CALL exner_hyb_loc(ip1jmp1,ps,p,pks,pk)
    540         else
     540        else
    541541          CALL exner_milieu_loc(ip1jmp1,ps,p,pks,pk)
    542542        endif
    … …  
    544544        unskap=1./kappa
    545545!$OMP DO
    546         DO l = 1, llm
    547             DO j=jjbu,jjeu
    548                 DO i =1, iip1
    549                     p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    550                 ENDDO
    551             ENDDO
    552         ENDDO
    553 !$OMP MASTER
    554         CALL guide_out("P",jjp1,llm,p,1.)
    555 !$OMP END MASTER
    556 !$OMP BARRIER
     546        DO l = 1, llm
     547            DO j=jjbu,jjeu
     548                DO i =1, iip1
     549                    p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     550                ENDDO
     551            ENDDO
     552        ENDDO
     553        CALL guide_out("SP",jjp1,llm,p,1.)
    557554    ENDIF
    558555   
    … …  
    574571        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
    575572        CALL guide_addfield_u(llm,f_addu,alpha_u)
    576 !        CALL WriteField_u('f_addu',f_addu)
    577 !        CALL WriteField_u('alpha_u',alpha_u)
    578 !$OMP MASTER
    579         IF (f_out) CALL guide_out("U",jjp1,llm,f_addu(:,:),factt)
    580 !$OMP END MASTER
    581 !$OMP BARRIER
    582 
     573!       IF (f_out) CALL guide_out("ua",jjp1,llm,ugui1(ijb_u:ije_u,:),factt)
     574        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
     575        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
     576        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:),factt)
    583577!$OMP DO
    584578        DO l=1,llm
    … …  
    602596        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
    603597        CALL guide_addfield_u(llm,f_addu,alpha_T)
    604 !$OMP MASTER
    605         IF (f_out) CALL guide_out("T",jjp1,llm,f_addu(:,:),factt)
    606 !$OMP END MASTER
    607 !$OMP BARRIER
     598        IF (f_out) CALL guide_out("teta",jjp1,llm,f_addu(:,:)/factt,factt)
    608599!$OMP DO
    609600        DO l=1,llm
    … …  
    626617        if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1))
    627618        CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P)
    628 !$OMP MASTER
    629         IF (f_out) CALL guide_out("SP",jjp1,1,f_addu(1:ip1jmp1,1),factt)
    630 !$OMP END MASTER
    631 !$OMP BARRIER
     619        IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(1:ip1jmp1,1)/factt,factt)
    632620!$OMP MASTER
    633621        ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_addu(ijbu:ijeu,1)
    … …  
    653641        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
    654642        CALL guide_addfield_u(llm,f_addu,alpha_Q)
    655 !$OMP MASTER
    656         IF (f_out) CALL guide_out("Q",jjp1,llm,f_addu(:,:),factt)
    657 !$OMP END MASTER
    658 !$OMP BARRIER
     643        IF (f_out) CALL guide_out("q",jjp1,llm,f_addu(:,:)/factt,factt)
    659644
    660645!$OMP DO
    … …  
    678663
    679664        endif
    680 !        CALL WriteField_v('f_addv',f_addv)       
    681665   
    682666        if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_addv(ijb_v:ije_v,:))
    683 !        CALL WriteField_v('f_addv',f_addv)       
    684667       
    685668        CALL guide_addfield_v(llm,f_addv(ijb_v:ije_v,:),alpha_v)
    686 !        CALL WriteField_v('f_addv',f_addv)       
    687 !        CALL WriteField_v('alpha_v',alpha_v)       
    688 !$OMP MASTER
    689         IF (f_out) CALL guide_out("V",jjm,llm,f_addv(1:ip1jm,:),factt)
    690 !$OMP END MASTER
    691 !$OMP BARRIER
    692 !        CALL WriteField_v('f_addv',f_addv)       
     669        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
     670        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
     671        IF (f_out) CALL guide_out("vcov",jjm,llm,f_addv(:,:)/factt,factt)
    693672
    694673!$OMP DO
    … …  
    697676        ENDDO
    698677    endif
    699 
    700 !    CALL WriteField_u('ucov_guide',ucov)
    701 !    CALL WriteField_v('vcov_guide',vcov)
    702 !    CALL WriteField_u('teta_guide',teta)
    703 !    CALL WriteField_u('masse_guide',masse)
    704678
    705679  END SUBROUTINE guide_main
    … …  
    1022996                DO i =1, iip1
    1023997                    pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
    1024                 ENDDO
    1025             ENDDO
     998                ENDDO
     999            ENDDO
    10261000        ENDDO
    10271001    ELSE
    1028         CALL pression_loc( ijnb_u, ap, bp, psi, p )
    1029         if (disvert_type==1) then
     1002        CALL pression_loc( ijnb_u, ap, bp, psi, p )
     1003        if (disvert_type==1) then
    10301004          CALL exner_hyb_loc(ijnb_u,psi,p,pks,pk)
    10311005        else ! we assume that we are in the disvert_type==2 case
    10321006          CALL exner_milieu_loc(ijnb_u,psi,p,pks,pk)
    10331007        endif
    1034         unskap=1./kappa
    1035 !$OMP BARRIER
    1036 !$OMP DO
    1037         DO l = 1, llm
    1038             DO j=jjbu,jjeu
    1039                 DO i =1, iip1
    1040                     pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    1041                 ENDDO
    1042             ENDDO
    1043         ENDDO
     1008        unskap=1./kappa
     1009!$OMP BARRIER
     1010!$OMP DO
     1011   DO l = 1, llm
     1012       DO j=jjbu,jjeu
     1013        DO i =1, iip1
     1014            pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     1015        ENDDO
     1016       ENDDO
     1017   ENDDO
    10441018    ENDIF
    10451019
    … …  
    17511725     endif
    17521726
     1727
    17531728!  Temperature
    17541729     if (guide_T) then
    … …  
    19041879             if (ncidpl.eq.-99) ncidpl=ncidu
    19051880         endif
     1881
    19061882! Vent meridien
    19071883         if (guide_v) then
    … …  
    20412017     endif
    20422018
     2019
    20432020!  Temperature
    20442021     if (guide_T) then
    … …  
    21262103 
    21272104!=======================================================================
    2128   SUBROUTINE guide_out(varname,hsize,vsize,field,factt)
     2105  SUBROUTINE guide_out(varname,hsize,vsize,field_loc,factt)
    21292106    USE parallel_lmdz
     2107    USE mod_hallo, ONLY : gather_field_u, gather_field_v
    21302108    IMPLICIT NONE
    21312109
    … …  
    21382116   
    21392117    ! Variables entree
    2140     CHARACTER, INTENT(IN)                          :: varname
     2118    CHARACTER*(*), INTENT(IN)                      :: varname
    21412119    INTEGER,   INTENT (IN)                         :: hsize,vsize
    2142     REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
     2120    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
    21432121    REAL, INTENT (IN)                              :: factt
    21442122
    … …  
    21482126    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    21492127    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     2128    INTEGER       :: vid_au,vid_av
    21502129    INTEGER, DIMENSION (3) :: dim3
    21512130    INTEGER, DIMENSION (4) :: dim4,count,start
    2152     INTEGER                :: ierr, varid
    2153    
    2154     CALL gather_field(field,iip1*hsize,vsize,0)
    2155    
     2131    INTEGER                :: ierr, varid,l
     2132    REAL zu(ip1jmp1),zv(ip1jm)
     2133    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: field_glo
     2134   
     2135!$OMP MASTER
     2136
     2137    ALLOCATE(field_glo(iip1,hsize,vsize))
     2138    IF (hsize==jjp1) THEN
     2139       CALL gather_field_u(field_loc,field_glo,vsize)
     2140    ELSE IF (hsize==jjm) THEN
     2141       CALL gather_field_v(field_loc,field_glo, vsize)
     2142    ENDIF
     2143
     2144    CALL Gather_field_u(alpha_u,zu,1)
     2145    CALL Gather_field_v(alpha_v,zv,1)
     2146
    21562147    IF (mpi_rank /= 0) RETURN
    21572148   
    2158     print *,'Guide: output timestep',timestep,'var ',varname
     2149!   print *,'Guide: output timestep',timestep,'var ',varname
    21592150    IF (timestep.EQ.0) THEN
    21602151! ----------------------------------------------
    … …  
    21792170        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
    21802171        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
    2181        
     2172        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
     2173        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
     2174
    21822175        ierr=NF_ENDDEF(nid)
    21832176
    … …  
    21912184        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    21922185        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     2186        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,zu)
     2187        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,zv)
    21932188#else
    21942189        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    … …  
    21992194        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    22002195        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     2196        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     2197        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
    22012198#endif
    22022199! --------------------------------------------------------------------
    … …  
    22062203! Pressure (GCM)
    22072204        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
    2208         ierr = NF_DEF_VAR(nid,"P",NF_FLOAT,4,dim4,varid)
     2205        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
    22092206! Surface pressure (guidage)
    22102207        IF (guide_P) THEN
    … …  
    22152212        IF (guide_u) THEN
    22162213            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
     2214            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
     2215            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
    22172216            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    22182217        ENDIF
    … …  
    22202219        IF (guide_v) THEN
    22212220            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
     2221            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
     2222            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
    22222223            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    22232224        ENDIF
    … …  
    22432244    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    22442245
     2246    IF (varname=="SP") timestep=timestep+1
     2247
     2248    ierr = NF_INQ_VARID(nid,varname,varid)
    22452249    SELECT CASE (varname)
    2246     CASE ("P")
    2247         timestep=timestep+1
    2248         ierr = NF_INQ_VARID(nid,"P",varid)
     2250    CASE ("SP","ps")
    22492251        start=(/1,1,1,timestep/)
    22502252        count=(/iip1,jjp1,llm,1/)
    2251 #ifdef NC_DOUBLE
    2252         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    2253 #else
    2254         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    2255 #endif
    2256     CASE ("SP")
    2257         ierr = NF_INQ_VARID(nid,"ps",varid)
    2258         start=(/1,1,timestep,0/)
    2259         count=(/iip1,jjp1,1,0/)
    2260 #ifdef NC_DOUBLE
    2261         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2262 #else
    2263         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2264 #endif
    2265     CASE ("U")
    2266         ierr = NF_INQ_VARID(nid,"ucov",varid)
     2253    CASE ("v","va","vcov")
     2254        start=(/1,1,1,timestep/)
     2255        count=(/iip1,jjm,llm,1/)
     2256    CASE DEFAULT
    22672257        start=(/1,1,1,timestep/)
    22682258        count=(/iip1,jjp1,llm,1/)
     2259    END SELECT
     2260
     2261    SELECT CASE (varname)
     2262
     2263    CASE("u","ua")
     2264        DO l=1,llm ; field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
     2265        field_glo(:,1,:)=0. ; field_glo(:,jjp1,:)=0.
     2266    CASE("v","va")
     2267        DO l=1,llm ; field_glo(:,:,l)=field_glo(:,:,l)/cv(:,:) ; ENDDO
     2268    END SELECT
     2269
     2270!    if (varname=="ua") then
     2271!    call dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
     2272!    call dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
     2273!    endif
    22692274#ifdef NC_DOUBLE
    2270         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     2275    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field_glo)
    22712276#else
    2272         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
     2277    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field_glo)
    22732278#endif
    2274     CASE ("V")
    2275         ierr = NF_INQ_VARID(nid,"vcov",varid)
    2276         start=(/1,1,1,timestep/)
    2277         count=(/iip1,jjm,llm,1/)
    2278 #ifdef NC_DOUBLE
    2279         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2280 #else
    2281         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2282 #endif
    2283     CASE ("T")
    2284         ierr = NF_INQ_VARID(nid,"teta",varid)
    2285         start=(/1,1,1,timestep/)
    2286         count=(/iip1,jjp1,llm,1/)
    2287 #ifdef NC_DOUBLE
    2288         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2289 #else
    2290         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2291 #endif
    2292     CASE ("Q")
    2293         ierr = NF_INQ_VARID(nid,"q",varid)
    2294         start=(/1,1,1,timestep/)
    2295         count=(/iip1,jjp1,llm,1/)
    2296 #ifdef NC_DOUBLE
    2297         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2298 #else
    2299         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2300 #endif
    2301     END SELECT
    2302  
     2279
    23032280    ierr = NF_CLOSE(nid)
     2281
     2282
     2283!$OMP END MASTER
     2284!$OMP BARRIER
     2285
     2286    RETURN
    23042287
    23052288  END SUBROUTINE guide_out
    … …  
    23252308  end subroutine correctbid
    23262309
     2310
     2311!====================================================================
     2312! Ascii debug output. Could be reactivated
     2313!====================================================================
     2314
     2315subroutine dump2du(var,varname)
     2316use parallel_lmdz
     2317use mod_hallo
     2318implicit none
     2319include 'dimensions.h'
     2320include 'paramet.h'
     2321
     2322      CHARACTER (len=*) :: varname
     2323
     2324
     2325real, dimension(ijb_u:ije_u) :: var
     2326
     2327real, dimension(ip1jmp1) :: var_glob
     2328
     2329    RETURN
     2330
     2331    call barrier
     2332    CALL Gather_field_u(var,var_glob,1)
     2333    call barrier
     2334
     2335    if (mpi_rank==0) then
     2336       call dump2d(iip1,jjp1,var_glob,varname)
     2337    endif
     2338
     2339    call barrier
     2340
     2341    return
     2342    end subroutine dump2du
     2343
     2344!====================================================================
     2345! Ascii debug output. Could be reactivated
     2346!====================================================================
     2347subroutine dumpall
     2348     implicit none
     2349     include "dimensions.h"
     2350     include "paramet.h"
     2351     include "comgeom.h"
     2352     call barrier
     2353     call dump2du(alpha_u(ijb_u:ije_u),'  alpha_u couche 1')
     2354     call dump2du(unat2(:,jjbu:jjeu,nlevnc),'  unat2 couche nlevnc')
     2355     call dump2du(ugui1(ijb_u:ije_u,1)*sqrt(unscu2(ijb_u:ije_u)),'  ugui1 couche 1')
     2356     return
     2357end subroutine dumpall
     2358
    23272359!===========================================================================
    23282360END MODULE guide_loc_mod
Note: See TracChangeset for help on using the changeset viewer.