Ignore:
Timestamp:
Jun 11, 2014, 3:46:46 PM (11 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r1997:2055 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 deleted
10 edited
2 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F

    r1999 r2056  
    219219      REAL unskap, pksurcp
    220220c
    221 cIM diagnostique PVteta, Amip2
    222       INTEGER,PARAMETER :: ntetaSTD=3
    223       REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
    224       REAL PVteta(klon,ntetaSTD)
    225      
    226      
    227221      REAL SSUM
    228222
    … …  
    252246      klon=klon_mpi
    253247     
    254       PVteta(:,:)=0.
    255            
    256248c
    257249      IF ( firstcal )  THEN
    … …  
    510502      endif
    511503
    512 
    513       IF (is_sequential.and.(planet_type=="earth")) THEN
    514 #ifdef CPP_PHYS
    515 ! PVtheta calls tetalevel, which is in the physics
    516 cIM calcul PV a teta=350, 380, 405K
    517         CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
    518      $           ztfi,zplay,zplev,
    519      $           ntetaSTD,rtetaSTD,PVteta)
    520 c
    521 #endif
    522       ENDIF
    523 
    524504c On change de grille, dynamique vers physiq, pour le flux de masse verticale
    525505c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    707687     .             zdqfi_omp,
    708688     .             zdpsrf_omp,
    709 cIM diagnostique PVteta, Amip2         
    710      .             pducov,
    711      .             PVteta)
     689     .             pducov)
    712690
    713691      else if ( planet_type=="generic" ) then

  • LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90

    r1999 r2056  
    1212
    1313    REAL,POINTER,SAVE :: p(:,:)
    14     REAL,POINTER,SAVE :: alpha(:,:)
    15     REAL,POINTER,SAVE :: beta(:,:)
    1614    REAL,POINTER,SAVE :: pks(:)
    1715    REAL,POINTER,SAVE :: pk(:,:)
    … …  
    5351    CALL allocate_u(flxw,llm,d)
    5452    CALL allocate_u(p,llmp1,d)
    55     CALL allocate_u(alpha,llm,d)
    56     CALL allocate_u(beta,llm,d)
    5753    CALL allocate_u(pks,d)
    5854    CALL allocate_u(pk,llm,d)
    … …  
    7571                         phis_dyn,q_dyn,flxw_dyn)
    7672  USE dimensions_mod
     73  use exner_hyb_loc_m, only: exner_hyb_loc
     74  use exner_milieu_loc_m, only: exner_milieu_loc
    7775  USE parallel_lmdz
    7876  USE times
    … …  
    201199
    202200  !$OMP BARRIER
    203     CALL exner_hyb_loc(  ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     201    CALL exner_hyb_loc(  ip1jmp1, ps, p, pks, pk, pkf )
    204202  !$OMP BARRIER
    205203    CALL geopot_loc  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
    … …  
    343341!$OMP BARRIER
    344342    if (pressure_exner) then
    345       CALL exner_hyb_loc(ijnb_u,ps,p,alpha,beta,pks,pk,pkf)
     343      CALL exner_hyb_loc(ijnb_u,ps,p,pks,pk,pkf)
    346344    else
    347       CALL exner_milieu_loc(ijnb_u,ps,p,beta,pks,pk,pkf)
     345      CALL exner_milieu_loc(ijnb_u,ps,p,pks,pk,pkf)
    348346    endif
    349347!$OMP BARRIER

  • LMDZ5/branches/testing/libf/dyn3dmem/gcm.F

    r1999 r2056  
    9898      REAL,ALLOCATABLE,SAVE  :: ps(:)         ! pression  au sol
    9999c      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    100 c      REAL pks(ip1jmp1)                      ! exner au  sol
    101 c      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    102 c      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    103100      REAL,ALLOCATABLE,SAVE  :: masse(:,:)    ! masse d'air
    104101      REAL,ALLOCATABLE,SAVE  :: phis(:)       ! geopotentiel au sol
    … …  
    124121      data call_iniphys/.true./
    125122
    126 c      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
    127123c+jld variables test conservation energie
    128124c      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
    … …  
    481477
    482478
    483       day_end = day_ini + nday
     479      if (nday>=0) then
     480         day_end = day_ini + nday
     481      else
     482         day_end = day_ini - nday/day_step
     483      endif
     484 
    484485      WRITE(lunout,300)day_ini,day_end
    485486 300  FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)

  • LMDZ5/branches/testing/libf/dyn3dmem/guide_loc_mod.F90

    r1910 r2056  
    329329!=======================================================================
    330330  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
     331    use exner_hyb_loc_m, only: exner_hyb_loc
     332    use exner_milieu_loc_m, only: exner_milieu_loc
    331333    USE parallel_lmdz
    332334    USE control_mod
    … …  
    353355    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addv ! var aux: champ de guidage
    354356    ! Variables pour fonction Exner (P milieu couche)
    355     REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: pk, pkf
    356     REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: alpha, beta
     357    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: pk
    357358    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks   
    358359    REAL                               :: unskap
    … …  
    367368   
    368369    INTEGER       :: i,j,l
     370    INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM
    369371       
    370372!$OMP MASTER   
    … …  
    382384!$OMP BARRIER
    383385     
    384      PRINT *,'---> on rentre dans guide_main'
     386!    PRINT *,'---> on rentre dans guide_main'
    385387!    CALL AllGather_Field(ucov,ip1jmp1,llm)
    386388!    CALL AllGather_Field(vcov,ip1jm,llm)
    … …  
    399401        ALLOCATE(f_addv(ijb_v:ije_v,llm) )
    400402        ALLOCATE(pk(iip1,jjb_u:jje_u,llm)  )
    401         ALLOCATE(pkf(iip1,jjb_u:jje_u,llm)  )
    402         ALLOCATE(alpha(iip1,jjb_u:jje_u,llm)  )
    403         ALLOCATE(beta(iip1,jjb_u:jje_u,llm)  )
    404403        ALLOCATE(pks(iip1,jjb_u:jje_u)  )
    405404        ALLOCATE(p(ijb_u:ije_u,llmp1) )
    … …  
    431430        IF (ini_anal) THEN
    432431            CALL guide_interp(ps,teta)
    433 !$OMP DO            
     432!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
    434433            DO l=1,llm
    435434              IF (guide_u) ucov(ijbu:ijeu,l)=ugui2(ijbu:ijeu,l)
    … …  
    449448            ENDIF
    450449            RETURN
    451         ENDIF
    452 ! Verification structure guidage
    453         IF (guide_u) THEN
    454 !+tard            CALL writefield_u('unat',unat1)
    455 !            CALL writefield_u('ucov',ucov)
    456         ENDIF
    457         IF (guide_T) THEN
    458 !+tard            CALL writefield_p('tnat',tnat1)
    459 !            CALL writefield_u('teta',teta)
    460450        ENDIF
    461451
    … …  
    536526    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    537527    IF (f_out) THEN
    538 !       Calcul niveaux pression milieu de couches
    539         CALL pression_loc( ijnb_u, ap, bp, ps, p )
    540         if (pressure_exner) then
    541           CALL exner_hyb_loc(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
    542         else
    543           CALL exner_milieu_loc(ip1jmp1,ps,p,beta,pks,pk,pkf)
    544         endif
    545 !$OMP BARRIER       
     528
     529!$OMP BARRIER
     530      CALL pression_loc(ijnb_u,ap,bp,ps,p)
     531
     532!$OMP BARRIER
     533      if (pressure_exner) then
     534      CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk)
     535      else
     536        CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk )
     537      endif
     538
     539!$OMP BARRIER
     540
    546541        unskap=1./kappa
    547 !$OMP DO
    548         DO l = 1, llm
    549             DO j=jjbu,jjeu
    550                 DO i =1, iip1
    551                     p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    552                 ENDDO
    553             ENDDO
    554         ENDDO
    555 !$OMP MASTER
    556         CALL guide_out("P",jjp1,llm,p,1.)
    557 !$OMP END MASTER
    558 !$OMP BARRIER
     542!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     543        DO l = 1, llm
     544            DO j=jjbu,jjeu
     545                DO i =1, iip1
     546                    p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     547                ENDDO
     548            ENDDO
     549        ENDDO
     550
     551!!$OMP MASTER
     552!     DO l=1,llm,5
     553!         print*,'avant dump2d l=',l,mpi_rank,OMP_GET_THREAD_NUM()
     554!         print*,'avant dump2d l=',l,mpi_rank
     555!         CALL dump2d(iip1,jjnb_u,p(:,l),'ppp   ')
     556!      ENDDO
     557!!$OMP END MASTER
     558!!$OMP BARRIER
     559
     560        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
    559561    ENDIF
    560562   
    561563    if (guide_u) then
    562564        if (guide_add) then
    563 !$OMP DO
     565!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    564566          DO l=1,llm
    565567           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)
    566568          ENDDO
    567569        else
    568 !$OMP DO
     570!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    569571          DO l=1,llm
    570572           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)-ucov(ijbu:ijeu,l)
    … …  
    576578        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
    577579        CALL guide_addfield_u(llm,f_addu,alpha_u)
    578 !        CALL WriteField_u('f_addu',f_addu)
    579 !        CALL WriteField_u('alpha_u',alpha_u)
    580 !$OMP MASTER
    581         IF (f_out) CALL guide_out("U",jjp1,llm,f_addu(:,:),factt)
    582 !$OMP END MASTER
    583 !$OMP BARRIER
    584 
    585 !$OMP DO
     580!       IF (f_out) CALL guide_out("ua",jjp1,llm,ugui1(ijb_u:ije_u,:),factt)
     581        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
     582        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
     583        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:),factt)
     584!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    586585        DO l=1,llm
    587586          ucov(ijbu:ijeu,l)=ucov(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
    … …  
    592591    if (guide_T) then
    593592        if (guide_add) then
    594 !$OMP DO
     593!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    595594          DO l=1,llm
    596595            f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)
    597596          ENDDO
    598597        else
    599 !$OMP DO
     598!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    600599          DO l=1,llm
    601600           f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)-teta(ijbu:ijeu,l)
    … …  
    604603        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
    605604        CALL guide_addfield_u(llm,f_addu,alpha_T)
    606 !$OMP MASTER
    607         IF (f_out) CALL guide_out("T",jjp1,llm,f_addu(:,:),factt)
    608 !$OMP END MASTER
    609 !$OMP BARRIER
    610 !$OMP DO
     605        IF (f_out) CALL guide_out("teta",jjp1,llm,f_addu(:,:)/factt,factt)
     606!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    611607        DO l=1,llm
    612608          teta(ijbu:ijeu,l)=teta(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
    … …  
    628624        if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1))
    629625        CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P)
    630 !$OMP MASTER
    631         IF (f_out) CALL guide_out("SP",jjp1,1,f_addu(1:ip1jmp1,1),factt)
    632 !$OMP END MASTER
    633 !$OMP BARRIER
     626!       IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(ijb_u:ije_u,1)/factt,factt)
    634627!$OMP MASTER
    635628        ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_addu(ijbu:ijeu,1)
    … …  
    643636    if (guide_Q) then
    644637        if (guide_add) then
    645 !$OMP DO
     638!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    646639          DO l=1,llm
    647640            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)
    648641          ENDDO
    649642        else
    650 !$OMP DO
     643!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    651644          DO l=1,llm
    652645            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)-q(ijbu:ijeu,l)
    … …  
    655648        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
    656649        CALL guide_addfield_u(llm,f_addu,alpha_Q)
    657 !$OMP MASTER
    658         IF (f_out) CALL guide_out("Q",jjp1,llm,f_addu(:,:),factt)
    659 !$OMP END MASTER
    660 !$OMP BARRIER
    661 
    662 !$OMP DO
     650        IF (f_out) CALL guide_out("q",jjp1,llm,f_addu(:,:)/factt,factt)
     651
     652!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    663653        DO l=1,llm
    664654          q(ijbu:ijeu,l)=q(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
    … …  
    668658    if (guide_v) then
    669659        if (guide_add) then
    670 !$OMP DO
     660!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    671661          DO l=1,llm
    672662             f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)
    … …  
    674664
    675665        else
    676 !$OMP DO
     666!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    677667          DO l=1,llm
    678668            f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)-vcov(ijbv:ijev,l)
    … …  
    680670
    681671        endif
    682 !        CALL WriteField_v('f_addv',f_addv)       
    683672   
    684673        if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_addv(ijb_v:ije_v,:))
    685 !        CALL WriteField_v('f_addv',f_addv)       
    686674       
    687675        CALL guide_addfield_v(llm,f_addv(ijb_v:ije_v,:),alpha_v)
    688 !        CALL WriteField_v('f_addv',f_addv)       
    689 !        CALL WriteField_v('alpha_v',alpha_v)       
    690 !$OMP MASTER
    691         IF (f_out) CALL guide_out("V",jjm,llm,f_addv(1:ip1jm,:),factt)
    692 !$OMP END MASTER
    693 !$OMP BARRIER
    694 !        CALL WriteField_v('f_addv',f_addv)       
    695 
    696 !$OMP DO
     676        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
     677        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
     678        IF (f_out) CALL guide_out("vcov",jjm,llm,f_addv(:,:)/factt,factt)
     679
     680!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    697681        DO l=1,llm
    698682          vcov(ijbv:ijev,l)=vcov(ijbv:ijev,l)+f_addv(ijbv:ijev,l)
    … …  
    700684    endif
    701685
    702 !    CALL WriteField_u('ucov_guide',ucov)
    703 !    CALL WriteField_v('vcov_guide',vcov)
    704 !    CALL WriteField_u('teta_guide',teta)
    705 !    CALL WriteField_u('masse_guide',masse)
    706 
    707686  END SUBROUTINE guide_main
    708687
    … …  
    723702    INTEGER :: l
    724703
    725 !$OMP DO
     704!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    726705    DO l=1,vsize
    727706      field(ijbu:ijeu,l)=alpha(ijbu:ijeu)*field(ijbu:ijeu,l)*alpha_pcor(l)
    … …  
    746725    INTEGER :: l
    747726
    748 !$OMP DO
     727!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    749728    DO l=1,vsize
    750729      field(ijbv:ijev,l)=alpha(ijbv:ijev)*field(ijbv:ijev,l)*alpha_pcor(l)
    … …  
    799778
    800779   
    801 !$OMP DO
     780!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    802781      DO l=1,vsize
    803782        fieldm(:,l)=0.
    … …  
    869848    ENDIF
    870849
    871 !$OMP DO
     850!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    872851      DO l=1,vsize
    873852      ! Compute zonal average
    … …  
    894873!=======================================================================
    895874  SUBROUTINE guide_interp(psi,teta)
     875    use exner_hyb_loc_m, only: exner_hyb_loc
     876    use exner_milieu_loc_m, only: exner_milieu_loc
    896877  USE parallel_lmdz
    897878  USE mod_hallo
    … …  
    919900  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: pbary
    920901  ! Variables pour fonction Exner (P milieu couche)
    921   REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pk, pkf
    922   REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: alpha, beta
     902  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pk
    923903  REAL ,ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks   
    924904  REAL                               :: unskap
    … …  
    949929      ALLOCATE(pbary(iip1,jjb_v:jje_v,llm) )   
    950930      ALLOCATE(pk(iip1,jjb_u:jje_u,llm) )   
    951       ALLOCATE(pkf(iip1,jjb_u:jje_u,llm)  )   
    952       ALLOCATE(alpha(iip1,jjb_u:jje_u,llm) )   
    953       ALLOCATE(beta(iip1,jjb_u:jje_u,llm) )   
    954931      ALLOCATE(pks (iip1,jjb_u:jje_u) )   
    955932      ALLOCATE(qsat(ijb_u:ije_u,llm) )   
    … …  
    1021998!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
    1022999    IF (guide_plevs.EQ.1) THEN
    1023 !$OMP DO
     1000!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10241001        DO l=1,llm
    10251002            DO j=jjbu,jjeu
    10261003                DO i =1, iip1
    10271004                    pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
    1028                 ENDDO
    1029             ENDDO
     1005                ENDDO
     1006            ENDDO
    10301007        ENDDO
    10311008    ELSE
    1032         CALL pression_loc( ijnb_u, ap, bp, psi, p )
    1033         if (disvert_type==1) then
    1034           CALL exner_hyb_loc(ijnb_u,psi,p,alpha,beta,pks,pk,pkf)
     1009        CALL pression_loc( ijnb_u, ap, bp, psi, p )
     1010        if (disvert_type==1) then
     1011          CALL exner_hyb_loc(ijnb_u,psi,p,pks,pk)
    10351012        else ! we assume that we are in the disvert_type==2 case
    1036           CALL exner_milieu_loc(ijnb_u,psi,p,beta,pks,pk,pkf)
     1013          CALL exner_milieu_loc(ijnb_u,psi,p,pks,pk)
    10371014        endif
    1038         unskap=1./kappa
    1039 !$OMP BARRIER
    1040 !$OMP DO
    1041         DO l = 1, llm
    1042             DO j=jjbu,jjeu
    1043                 DO i =1, iip1
    1044                     pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    1045                 ENDDO
    1046             ENDDO
    1047         ENDDO
     1015        unskap=1./kappa
     1016!$OMP BARRIER
     1017!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1018   DO l = 1, llm
     1019       DO j=jjbu,jjeu
     1020        DO i =1, iip1
     1021            pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     1022        ENDDO
     1023       ENDDO
     1024   ENDDO
    10481025    ENDIF
    10491026
    10501027!   calcul des pressions pour les grilles u et v
    1051 !$OMP DO
     1028!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10521029    do l=1,llm
    10531030        do j=jjbu,jjeu
    … …  
    10661043    call massbar_loc(pext, pbarx, pbary )
    10671044!$OMP BARRIER
    1068 !$OMP DO
     1045!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10691046    do l=1,llm
    10701047        do j=jjbu,jjeu
    … …  
    10751052        enddo
    10761053    enddo
    1077 !$OMP DO
     1054!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10781055    do l=1,llm
    10791056        do j=jjbv,jjev
    … …  
    11361113!$OMP BARRIER
    11371114        ! Conversion en variables GCM
    1138 !$OMP DO
     1115!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    11391116        do l=1,llm
    11401117            do j=jjbu,jjeu
    … …  
    12061183        ! On suppose qu'on a la bonne variable dans le fichier de guidage:
    12071184        ! Hum.Rel si guide_hr, Hum.Spec. sinon.
    1208 !$OMP DO
     1185!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    12091186        do l=1,llm
    12101187            do j=jjbu,jjeu
    … …  
    12311208        enddo
    12321209        IF (guide_hr) THEN
    1233 !$OMP DO
     1210!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    12341211          do l=1,llm
    12351212            CALL q_sat(iip1*jjnu,teta(:,jjbu:jjeu,l)*pk(:,jjbu:jjeu,l)/cpp,       &
    … …  
    12841261
    12851262        ! Conversion en variables GCM
    1286 !$OMP DO
     1263!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    12871264        do l=1,llm
    12881265            do j=jjbu,jjeu
    … …  
    13591336!$OMP BARRIER
    13601337        ! Conversion en variables GCM
    1361 !$OMP DO
     1338!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    13621339        do l=1,llm
    13631340            do j=jjbv,jjev
    … …  
    17551732     endif
    17561733
     1734
    17571735!  Temperature
    17581736     if (guide_T) then
    … …  
    19081886             if (ncidpl.eq.-99) ncidpl=ncidu
    19091887         endif
     1888
    19101889! Vent meridien
    19111890         if (guide_v) then
    … …  
    20452024     endif
    20462025
     2026
    20472027!  Temperature
    20482028     if (guide_T) then
    … …  
    20962076
    20972077         IF (invert_y) THEN
     2078 
    20982079!           PRINT*,"Invertion impossible actuellement"
    20992080!           CALL abort_gcm(modname,abort_message,1)
    … …  
    21302111 
    21312112!=======================================================================
    2132   SUBROUTINE guide_out(varname,hsize,vsize,field,factt)
     2113  SUBROUTINE guide_out(varname,hsize,vsize,field_loc,factt)
    21332114    USE parallel_lmdz
     2115    USE mod_hallo, ONLY : gather_field_u, gather_field_v
    21342116    IMPLICIT NONE
    21352117
    … …  
    21422124   
    21432125    ! Variables entree
    2144     CHARACTER, INTENT(IN)                          :: varname
     2126    CHARACTER*(*), INTENT(IN)                      :: varname
    21452127    INTEGER,   INTENT (IN)                         :: hsize,vsize
    2146     REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
    2147     REAL, INTENT (IN)                              :: factt
     2128!   REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
     2129    REAL, DIMENSION (:,:), INTENT(IN) :: field_loc
     2130    REAL factt
    21482131
    21492132    ! Variables locales
    … …  
    21522135    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    21532136    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     2137    INTEGER       :: vid_au,vid_av
    21542138    INTEGER, DIMENSION (3) :: dim3
    21552139    INTEGER, DIMENSION (4) :: dim4,count,start
    2156     INTEGER                :: ierr, varid
    2157    
    2158     CALL gather_field(field,iip1*hsize,vsize,0)
    2159    
    2160     IF (mpi_rank /= 0) RETURN
    2161    
    2162     print *,'Guide: output timestep',timestep,'var ',varname
     2140    INTEGER                :: ierr, varid,l
     2141    REAL zu(ip1jmp1),zv(ip1jm)
     2142    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
     2143   
     2144!$OMP MASTER
     2145    ALLOCATE(field_glo(iip1,hsize,vsize))
     2146!$OMP END MASTER
     2147!$OMP BARRIER
     2148
     2149    print*,'gvide_out apres allocation ',hsize,vsize
     2150
     2151    IF (hsize==jjp1) THEN
     2152        CALL gather_field_u(field_loc,field_glo,vsize)
     2153    ELSE IF (hsize==jjm) THEN
     2154       CALL gather_field_v(field_loc,field_glo, vsize)
     2155    ENDIF
     2156
     2157    print*,'guide_out apres gather '
     2158    CALL Gather_field_u(alpha_u,zu,1)
     2159    CALL Gather_field_v(alpha_v,zv,1)
     2160
     2161    IF (mpi_rank >  0) THEN
     2162!$OMP MASTER
     2163       DEALLOCATE(field_glo)
     2164!$OMP END MASTER
     2165!$OMP BARRIER
     2166
     2167       RETURN
     2168    ENDIF
     2169   
     2170!$OMP MASTER
    21632171    IF (timestep.EQ.0) THEN
    21642172! ----------------------------------------------
    … …  
    21832191        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
    21842192        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
    2185        
     2193        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
     2194        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
     2195
    21862196        ierr=NF_ENDDEF(nid)
    21872197
    … …  
    21952205        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    21962206        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     2207        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,zu)
     2208        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,zv)
    21972209#else
    21982210        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    … …  
    22032215        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    22042216        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     2217        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     2218        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
    22052219#endif
    22062220! --------------------------------------------------------------------
    … …  
    22102224! Pressure (GCM)
    22112225        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
    2212         ierr = NF_DEF_VAR(nid,"P",NF_FLOAT,4,dim4,varid)
     2226        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
    22132227! Surface pressure (guidage)
    22142228        IF (guide_P) THEN
    … …  
    22192233        IF (guide_u) THEN
    22202234            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
     2235            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
     2236            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
    22212237            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    22222238        ENDIF
    … …  
    22242240        IF (guide_v) THEN
    22252241            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
     2242            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
     2243            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
    22262244            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    22272245        ENDIF
    … …  
    22472265    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    22482266
     2267    IF (varname=="SP") timestep=timestep+1
     2268
     2269    ierr = NF_INQ_VARID(nid,varname,varid)
    22492270    SELECT CASE (varname)
    2250     CASE ("P")
    2251         timestep=timestep+1
    2252         ierr = NF_INQ_VARID(nid,"P",varid)
     2271    CASE ("SP","ps")
    22532272        start=(/1,1,1,timestep/)
    22542273        count=(/iip1,jjp1,llm,1/)
    2255 #ifdef NC_DOUBLE
    2256         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    2257 #else
    2258         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    2259 #endif
    2260     CASE ("SP")
    2261         ierr = NF_INQ_VARID(nid,"ps",varid)
    2262         start=(/1,1,timestep,0/)
    2263         count=(/iip1,jjp1,1,0/)
    2264 #ifdef NC_DOUBLE
    2265         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2266 #else
    2267         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2268 #endif
    2269     CASE ("U")
    2270         ierr = NF_INQ_VARID(nid,"ucov",varid)
     2274    CASE ("v","va","vcov")
     2275        start=(/1,1,1,timestep/)
     2276        count=(/iip1,jjm,llm,1/)
     2277    CASE DEFAULT
    22712278        start=(/1,1,1,timestep/)
    22722279        count=(/iip1,jjp1,llm,1/)
     2280    END SELECT
     2281
     2282!$OMP END MASTER
     2283!$OMP BARRIER
     2284
     2285    SELECT CASE (varname)
     2286
     2287    CASE("u","ua")
     2288!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     2289        DO l=1,llm
     2290            field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm)
     2291            field_glo(:,1,l)=0. ; field_glo(:,jjp1,l)=0.
     2292        ENDDO
     2293    CASE("v","va")
     2294!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     2295        DO l=1,llm
     2296           field_glo(:,:,l)=field_glo(:,:,l)/cv(:,:)
     2297        ENDDO
     2298    END SELECT
     2299
     2300!    if (varname=="ua") then
     2301!    call dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
     2302!    call dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
     2303!    endif
     2304
     2305!$OMP MASTER
     2306
    22732307#ifdef NC_DOUBLE
    2274         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     2308    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field_glo)
    22752309#else
    2276         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
     2310    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field_glo)
    22772311#endif
    2278     CASE ("V")
    2279         ierr = NF_INQ_VARID(nid,"vcov",varid)
    2280         start=(/1,1,1,timestep/)
    2281         count=(/iip1,jjm,llm,1/)
    2282 #ifdef NC_DOUBLE
    2283         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2284 #else
    2285         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2286 #endif
    2287     CASE ("T")
    2288         ierr = NF_INQ_VARID(nid,"teta",varid)
    2289         start=(/1,1,1,timestep/)
    2290         count=(/iip1,jjp1,llm,1/)
    2291 #ifdef NC_DOUBLE
    2292         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2293 #else
    2294         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2295 #endif
    2296     CASE ("Q")
    2297         ierr = NF_INQ_VARID(nid,"q",varid)
    2298         start=(/1,1,1,timestep/)
    2299         count=(/iip1,jjp1,llm,1/)
    2300 #ifdef NC_DOUBLE
    2301         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
    2302 #else
    2303         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    2304 #endif
    2305     END SELECT
    2306  
     2312
    23072313    ierr = NF_CLOSE(nid)
     2314
     2315       DEALLOCATE(field_glo)
     2316!$OMP END MASTER
     2317!$OMP BARRIER
     2318
     2319    RETURN
    23082320
    23092321  END SUBROUTINE guide_out
    … …  
    23292341  end subroutine correctbid
    23302342
     2343
     2344!====================================================================
     2345! Ascii debug output. Could be reactivated
     2346!====================================================================
     2347
     2348subroutine dump2du(var,varname)
     2349use parallel_lmdz
     2350use mod_hallo
     2351implicit none
     2352include 'dimensions.h'
     2353include 'paramet.h'
     2354
     2355      CHARACTER (len=*) :: varname
     2356
     2357
     2358real, dimension(ijb_u:ije_u) :: var
     2359
     2360real, dimension(ip1jmp1) :: var_glob
     2361
     2362    RETURN
     2363
     2364    call barrier
     2365    CALL Gather_field_u(var,var_glob,1)
     2366    call barrier
     2367
     2368    if (mpi_rank==0) then
     2369       call dump2d(iip1,jjp1,var_glob,varname)
     2370    endif
     2371
     2372    call barrier
     2373
     2374    return
     2375    end subroutine dump2du
     2376
     2377!====================================================================
     2378! Ascii debug output. Could be reactivated
     2379!====================================================================
     2380subroutine dumpall
     2381     implicit none
     2382     include "dimensions.h"
     2383     include "paramet.h"
     2384     include "comgeom.h"
     2385     call barrier
     2386     call dump2du(alpha_u(ijb_u:ije_u),'  alpha_u couche 1')
     2387     call dump2du(unat2(:,jjbu:jjeu,nlevnc),'  unat2 couche nlevnc')
     2388     call dump2du(ugui1(ijb_u:ije_u,1)*sqrt(unscu2(ijb_u:ije_u)),'  ugui1 couche 1')
     2389     return
     2390end subroutine dumpall
     2391
    23312392!===========================================================================
    23322393END MODULE guide_loc_mod

  • LMDZ5/branches/testing/libf/dyn3dmem/iniacademic_loc.F90

    r1910 r2056  
    44SUBROUTINE iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
    55
     6  use exner_hyb_m, only: exner_hyb
     7  use exner_milieu_m, only: exner_milieu
    68  USE filtreg_mod
    79  USE infotrac, ONLY : nqtot
    … …  
    5860  REAL pks(ip1jmp1)                      ! exner au  sol
    5961  REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    60   REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    6162  REAL phi(ip1jmp1,llm)                  ! geopotentiel
    6263  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
    … …  
    7576
    7677  REAL zdtvr
    77   real,allocatable :: alpha(:,:),beta(:,:)
    7878 
    7979  character(len=*),parameter :: modname="iniacademic"
    … …  
    219219       allocate(masse_glo(ip1jmp1,llm))
    220220       allocate(phis_glo(ip1jmp1))
    221        allocate(alpha(ip1jmp1,llm))
    222        allocate(beta(ip1jmp1,llm))
    223221
    224222        ! surface pressure
    … …  
    238236        CALL pression ( ip1jmp1, ap, bp, ps_glo, p       )
    239237        if (pressure_exner) then
    240           CALL exner_hyb( ip1jmp1, ps_glo, p,alpha,beta, pks, pk, pkf )
     238          CALL exner_hyb( ip1jmp1, ps_glo, p, pks, pk )
    241239        else
    242           call exner_milieu(ip1jmp1,ps_glo,p,beta,pks,pk,pkf)
     240          call exner_milieu(ip1jmp1,ps_glo,p,pks,pk)
    243241        endif
    244242        CALL massdair(p,masse_glo)
    … …  
    301299        deallocate(ps_glo)
    302300        deallocate(phis_glo)
    303         deallocate(alpha)
    304         deallocate(beta)
    305301     ENDIF ! of IF (.NOT. read_start)
    306302  endif academic_case

  • LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F

    r1999 r2056  
    3131       USE call_calfis_mod, ONLY : call_calfis
    3232       USE leapfrog_mod
     33       use exner_hyb_loc_m, only: exner_hyb_loc
     34       use exner_milieu_loc_m, only: exner_milieu_loc
    3335      IMPLICIT NONE
    3436
    … …  
    156158      character*10 string10
    157159
    158 !      REAL,SAVE,ALLOCATABLE :: alpha(:,:),beta(:,:)
    159160!      REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale
    160161
    … …  
    213214      lafin=.false.
    214215     
    215       itaufin   = nday*day_step
     216      if (nday>=0) then
     217         itaufin   = nday*day_step
     218      else
     219         itaufin   = -nday
     220      endif
     221
    216222      itaufinp1 = itaufin +1
    217223
    … …  
    261267!      ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
    262268!      ALLOCATE(finvmaold(ijb_u:ije_u,llm))
    263 !      ALLOCATE(alpha(ijb_u:ije_u,llm),beta(ijb_u:ije_u,llm))
    264269!      ALLOCATE(flxw(ijb_u:ije_u,llm))
    265270!      ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm))
    … …  
    284289c$OMP END MASTER
    285290      if (pressure_exner) then
    286       CALL exner_hyb_loc( ijnb_u, ps, p,alpha,beta, pks, pk, pkf)
     291      CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf)
    287292      else
    288         CALL exner_milieu_loc( ijnb_u, ps, p, beta, pks, pk, pkf )
     293        CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
    289294      endif
    290295c-----------------------------------------------------------------------
    … …  
    780785
    781786! c$OMP BARRIER
    782 !          CALL exner_hyb_loc(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
     787!          CALL exner_hyb_loc(  ip1jmp1, ps, p,pks, pk, pkf )
    783788! c$OMP BARRIER
    784789!            jD_cur = jD_ref + day_ini - day_ref
    … …  
    11351140c$OMP BARRIER
    11361141        if (pressure_exner) then
    1137         CALL exner_hyb_loc( ijnb_u, ps, p,alpha,beta, pks, pk, pkf )
     1142        CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf )
    11381143        else
    1139           CALL exner_milieu_loc( ijnb_u, ps, p, beta, pks, pk, pkf )
     1144          CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
    11401145        endif
    11411146c$OMP BARRIER

  • LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_mod.F90

    r1999 r2056  
    2727  REAL,POINTER,SAVE :: dq(:,:,:)
    2828  REAL,POINTER,SAVE :: finvmaold(:,:)
    29   REAL,POINTER,SAVE :: alpha(:,:)
    30   REAL,POINTER,SAVE :: beta(:,:)
    3129  REAL,POINTER,SAVE :: flxw(:,:)
    3230  REAL,POINTER,SAVE :: unat(:,:)
    … …  
    7977    CALL allocate_u(dq,llm,nqtot,d)
    8078    CALL allocate_u(finvmaold,llm,d)
    81     CALL allocate_u(alpha,llm,d)
    82     CALL allocate_u(beta,llm,d)
    8379    CALL allocate_u(flxw,llm,d)
    8480    CALL allocate_u(unat,llm,d)
    … …  
    129125    CALL switch_u(dq,distrib_caldyn,dist)
    130126    CALL switch_u(finvmaold,distrib_caldyn,dist)
    131     CALL switch_u(alpha,distrib_caldyn,dist)
    132     CALL switch_u(beta,distrib_caldyn,dist)
    133127    CALL switch_u(flxw,distrib_caldyn,dist)
    134128    CALL switch_u(unat,distrib_caldyn,dist)

  • LMDZ5/branches/testing/libf/dyn3dmem/mod_const_mpi.F90

    r1999 r2056  
    2121    USE mod_prism
    2222#endif
     23#ifdef CPP_XIOS
     24    USE wxios, only: wxios_init
     25#endif
    2326    IMPLICIT NONE
    2427#ifdef CPP_MPI
    … …  
    4144#ifdef CPP_COUPLE
    4245!$OMP MASTER
    43        CALL prism_init_comp_proto (comp_id, 'lmdz.x', ierr)
     46#ifdef CPP_XIOS
     47      CALL wxios_init("LMDZ", outcom=COMM_LMDZ, type_ocean=type_ocean)
     48#else
     49       CALL prism_init_comp_proto (comp_id, 'LMDZ', ierr)
    4450       CALL prism_get_localcomm_proto(COMM_LMDZ,ierr)
     51#endif
    4552!$OMP END MASTER
    4653#endif

  • LMDZ5/branches/testing/libf/dyn3dmem/parallel_lmdz.F90

    r1999 r2056  
    422422
    423423      if (type_ocean == 'couple') then
     424#ifdef CPP_XIOS
     425    !Fermeture propre de XIOS
     426      CALL wxios_close()
     427#else
    424428#ifdef CPP_COUPLE
    425429         call prism_terminate_proto(ierr)
    … …  
    428432         endif
    429433#endif
     434#endif
    430435      else
    431436#ifdef CPP_XIOS
Note: See TracChangeset for help on using the changeset viewer.