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

Merged trunk changes r1997:2055 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • 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
Note: See TracChangeset for help on using the changeset viewer.