Ignore:
Timestamp:
Jun 26, 2014, 6:07:05 PM (10 years ago)
Author:
emillour
Message:

Common dynamics:
Some updates to keep up with LMDZ5 Earth model evolution
(up to LMDZ5 rev 2070). See file "DOC/chantiers/commit_importants.log"
for detailed list of changes.
Note that the updates of exner* routines change (as expected) results
at numerical roundoff level.
EM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/dyn3d/guide_mod.F90

    r1300 r1302  
    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
    … …  
    589593  SUBROUTINE guide_interp(psi,teta)
    590594 
     595  use exner_hyb_m, only: exner_hyb
     596  use exner_milieu_m, only: exner_milieu
    591597  IMPLICIT NONE
    592598
    … …  
    610616  REAL, DIMENSION (iip1,jjm,llm)     :: pbary
    611617  ! Variables pour fonction Exner (P milieu couche)
    612   REAL, DIMENSION (iip1,jjp1,llm)    :: pk, pkf
    613   REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
     618  REAL, DIMENSION (iip1,jjp1,llm)    :: pk
    614619  REAL, DIMENSION (iip1,jjp1)        :: pks   
    615620  REAL                               :: prefkap,unskap
    … …  
    676681    CALL pression( ip1jmp1, ap, bp, psi, p )
    677682    if (pressure_exner) then
    678       CALL exner_hyb(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
     683      CALL exner_hyb(ip1jmp1,psi,p,pks,pk)
    679684    else
    680       CALL exner_milieu(ip1jmp1,psi,p,beta,pks,pk,pkf)
     685      CALL exner_milieu(ip1jmp1,psi,p,pks,pk)
    681686    endif
    682687!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
    … …  
    15071512   
    15081513    ! Variables entree
    1509     CHARACTER, INTENT(IN)                          :: varname
     1514    CHARACTER*(*), INTENT(IN)                          :: varname
    15101515    INTEGER,   INTENT (IN)                         :: hsize,vsize
    15111516    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
    … …  
    15161521    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    15171522    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     1523    INTEGER       :: vid_au,vid_av
    15181524    INTEGER, DIMENSION (3) :: dim3
    15191525    INTEGER, DIMENSION (4) :: dim4,count,start
    1520     INTEGER                :: ierr, varid
     1526    INTEGER                :: ierr, varid,l
     1527    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    15211528
    15221529    print *,'Guide: output timestep',timestep,'var ',varname
    … …  
    15421549        ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
    15431550        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)
    15441552        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)
    15451554       
    15461555        ierr=NF_ENDDEF(nid)
    … …  
    15551564        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    15561565        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)
    15571568#else
    15581569        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    … …  
    15631574        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    15641575        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)
    15651578#endif
    15661579! --------------------------------------------------------------------
    … …  
    15791592        IF (guide_u) THEN
    15801593            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)
    15811596            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    15821597        ENDIF
    … …  
    15841599        IF (guide_v) THEN
    15851600            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)
    15861603            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    15871604        ENDIF
    … …  
    16061623    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    16071624
     1625    IF (varname=="SP") timestep=timestep+1
     1626
     1627    ierr = NF_INQ_VARID(nid,varname,varid)
    16081628    SELECT CASE (varname)
    1609     CASE ("S")
    1610         timestep=timestep+1
    1611         ierr = NF_INQ_VARID(nid,"SP",varid)
     1629    CASE ("SP","ps")
    16121630        start=(/1,1,timestep,0/)
    16131631        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)
     1632    CASE ("v","va","vcov")
     1633        start=(/1,1,1,timestep/)
     1634        count=(/iip1,jjm,llm,1/)
     1635    CASE DEFAULT
    16301636        start=(/1,1,1,timestep/)
    16311637        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
    16321651#ifdef NC_DOUBLE
    1633         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
     1652    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
    16341653#else
    1635         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1654    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2)
    16361655#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  
     1656
    16661657    ierr = NF_CLOSE(nid)
    16671658
Note: See TracChangeset for help on using the changeset viewer.