Changeset 953


Ignore:
Timestamp:
May 2, 2013, 10:33:18 AM (12 years ago)
Author:
slebonnois
Message:

SL: optimisation pour le parallèle suite à tests Venus / petite correction appels routines secondaires dans Venus et Titan

Location:
trunk
Files:
2 deleted
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/dyn3dpar/advtrac_p.F90

    r270 r953  
    111111  !$OMP END DO NOWAIT
    112112
    113   !   selection de la masse instantannee des mailles avant le transport.
     113  !   selection de la masse instantanee des mailles avant le transport.
    114114  IF(iadvtr.EQ.0) THEN
    115115
    … …  
    206206     !$OMP BARRIER
    207207
    208      ! ... Flux de masse diaganostiques traceurs
     208     ! ... Flux de masse diagnostiques traceurs
    209209     ijb=ij_begin
    210210     ije=ij_end
    … …  
    266266
    267267
    268      GOTO 1234     
     268!!! ATTENTION !!!! TOUT CE QUI EST ENTRE ICI ET 1234 EST OBSOLETE !!!!!!!
     269     GOTO 1234
     270!!! ATTENTION !!!!
     271
    269272     !-----------------------------------------------------------
    270273     !     Appel des sous programmes d'advection
    … …  
    443446     end DO
    444447
     448!!! ATTENTION !!!!
    4454491234 CONTINUE
     450!!! ATTENTION !!!! LE CODE REPREND ICI !!!!!!!!
     451
    446452     !$OMP BARRIER
    447453
    … …  
    461467        CALL qminimum_p( q, 2, finmasse )
    462468
     469     endif ! of if (planet_type=="earth")
     470
    463471        !------------------------------------------------------------------
    464472        !   on reinitialise a zero les flux de masse cumules
    … …  
    471479        call VTb(VThallo)
    472480        !$OMP END MASTER
     481
    473482
    474483        do j=1,nqtot
    … …  
    492501 !$OMP BARRIER 
    493502        iadvtr=0
    494      endif ! of if (planet_type=="earth")
    495503  ENDIF ! if iadvtr.EQ.iapp_tracvl
    496504

  • trunk/LMDZ.COMMON/libf/dyn3dpar/cpdet.F

    r847 r953  
    9393c======================================================================
    9494
    95       SUBROUTINE t2tpot_p(ip1jmp1,llm, yt, yteta, ypk)
     95      SUBROUTINE t2tpot_p(nlon,nlev, yt, yteta, ypk)
    9696! Parallel version of t2tpot
    9797      USE parallel
    … …  
    102102#include "comconst.h"
    103103
    104       integer,intent(in) :: ip1jmp1,llm
    105       real,intent(in) :: yt(ip1jmp1,llm)
    106       real,intent(out) :: yteta(ip1jmp1,llm)
    107       real,intent(in) :: ypk(ip1jmp1,llm)
     104      integer,intent(in) :: nlon,nlev
     105      real,intent(in) :: yt(nlon,nlev)
     106      real,intent(out) :: yteta(nlon,nlev)
     107      real,intent(in) :: ypk(nlon,nlev)
    108108! local variable:
    109       integer :: ij,l,ijb,ije
     109      integer :: l
    110110     
    111       !ijb=ij_begin
    112       !ije=ij_end
    113       ijb=1
    114       ije=ip1jmp1
    115      
    116111      if (planet_type.eq."venus") then
    117 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    118         do l=1,llm
    119           yteta(ijb:ije,l)=yt(ijb:ije,l)**nu_venus                      &
     112        do l=1,nlev
     113          yteta(:,l)=yt(:,l)**nu_venus                                  &
    120114     &                     -nu_venus*t0_venus**nu_venus*                &
    121      &                          log(ypk(ijb:ije,l)/cpp)
    122           yteta(ijb:ije,l)=yteta(ijb:ije,l)**(1./nu_venus)
     115     &                          log(ypk(:,l)/cpp)
     116          yteta(:,l)=yteta(:,l)**(1./nu_venus)
    123117        enddo
    124 !$OMP END DO
    125118      else
    126 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    127         do l=1,llm
    128           yteta(ijb:ije,l)=yt(ijb:ije,l)*cpp/ypk(ijb:ije,l)
     119        do l=1,nlev
     120          yteta(:,l)=yt(:,l)*cpp/ypk(:,l)
    129121        enddo
    130 !$OMP END DO
    131122      endif ! of if (planet_type.eq."venus")
    132123
    … …  
    167158c======================================================================
    168159c======================================================================
    169       SUBROUTINE tpot2t_p(ip1jmp1,llm,yteta,yt,ypk)
     160      SUBROUTINE tpot2t_p(nlon,nlev,yteta,yt,ypk)
    170161! Parallel version of tpot2t
    171162      USE parallel
    … …  
    175166#include "comconst.h"
    176167
    177       integer,intent(in) :: ip1jmp1,llm
    178       real,intent(out) :: yt(ip1jmp1,llm)
    179       real,intent(in) :: yteta(ip1jmp1,llm)
    180       real,intent(in) :: ypk(ip1jmp1,llm)
     168      integer,intent(in) :: nlon,nlev
     169      real,intent(out) :: yt(nlon,nlev)
     170      real,intent(in) :: yteta(nlon,nlev)
     171      real,intent(in) :: ypk(nlon,nlev)
    181172
    182173! local variable:
    183       integer :: ij,l,ijb,ije
    184 
    185       !ijb=ij_begin
    186       !ije=ij_end
    187       ijb=1
    188       ije=ip1jmp1
     174      integer :: l
    189175
    190176      if (planet_type.eq."venus") then
    191 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    192         do l=1,llm
    193           yt(ijb:ije,l)=yteta(ijb:ije,l)**nu_venus                      &
     177        do l=1,nlev
     178          yt(:,l)=yteta(:,l)**nu_venus                                  &
    194179     &                  +nu_venus*t0_venus**nu_venus*                   &
    195      &                       log(ypk(ijb:ije,l)/cpp)
    196           yt(ijb:ije,l)=yt(ijb:ije,l)**(1./nu_venus)
     180     &                       log(ypk(:,l)/cpp)
     181          yt(:,l)=yt(:,l)**(1./nu_venus)
    197182        enddo
    198 !$OMP END DO
    199183      else
    200 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    201         do l=1,llm
    202           yt(ijb:ije,l)=yteta(ijb:ije,l)*ypk(ijb:ije,l)/cpp
     184        do l=1,nlev
     185          yt(:,l)=yteta(:,l)*ypk(:,l)/cpp
    203186        enddo
    204 !$OMP END DO
    205187      endif ! of if (planet_type.eq."venus")
    206188      END

  • trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F

    r847 r953  
    271271        dqfi(:,:,:) =0.
    272272        dpfi(:)     =0.
    273       dq(:,:,:)=0.
     273        dq(:,:,:)   =0.
    274274
    275275      CALL pression ( ip1jmp1, ap, bp, ps, p       )
    … …  
    549549c   --------------------------------
    550550! ADAPTATION GCM POUR CP(T)
    551       call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
    552551      ijb=ij_begin
    553552      ije=ij_end
     553      call tpot2t_p(ije-ijb+1,llm,teta(ijb:ije,:),temp(ijb:ije,:),
     554     &                            pk(ijb:ije,:))
    554555!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    555556      do l=1,llm
    … …  
    682683cc$OMP PARALLEL DEFAULT(SHARED)
    683684c
    684          CALL caladvtrac_p(q,pbaru,pbarv,
    685      *        p, masse, dq, teta,
    686      .        flxw,pk, iapptrac)
     685         CALL advtrac_p( pbaru,pbarv,
     686     *             p,  masse,q,iapptrac, teta,
     687     .             flxw, pk)
    687688
    688689C        Stokage du flux de masse pour traceurs OFF-LINE
    … …  
    12181219c   dissipation
    12191220! ADAPTATION GCM POUR CP(T)
    1220         call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
     1221            ijb=ij_begin
     1222            ije=ij_end
     1223        call tpot2t_p(ije-ijb+1,llm,teta(ijb:ije,:),temp(ijb:ije,:),
     1224     &                            pk(ijb:ije,:))
    12211225
    12221226!        CALL FTRACE_REGION_BEGIN("dissip")
    … …  
    12751279              enddo
    12761280            enddo
    1277 c$OMP END DO
    1278             call t2tpot_p(ip1jmp1,llm,temp,ztetaec,pk)
     1281c$OMP END DO
     1282        call t2tpot_p(ije-ijb+1,llm,temp(ijb:ije,:),ztetaec(ijb:ije,:),
     1283     &                            pk(ijb:ije,:))
    12791284c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    12801285            do l=1,llm
    … …  
    15851590
    15861591! ADAPTATION GCM POUR CP(T)
    1587       call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
    15881592      ijb=ij_begin
    15891593      ije=ij_end
     1594      call tpot2t_p(ije-ijb+1,llm,teta(ijb:ije,:),temp(ijb:ije,:),
     1595     &                            pk(ijb:ije,:))
    15901596!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    15911597      do l=1,llm
    … …  
    18091815
    18101816! ADAPTATION GCM POUR CP(T)
    1811                 call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
    18121817                ijb=ij_begin
    18131818                ije=ij_end
     1819           call tpot2t_p(ije-ijb+1,llm,teta(ijb:ije,:),temp(ijb:ije,:),
     1820     &                            pk(ijb:ije,:))
    18141821!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    18151822                do l=1,llm     

  • trunk/LMDZ.TITAN/libf/phytitan/physiq.F

    r887 r953  
    14361436c====================================================================
    14371437      if (ballons.eq.1) then
    1438          CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond,
     1438         CALL ballon(30,pdtphys,rjourvrai,gmtime*RDAY,rlatd,rlond,
    14391439c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
    14401440     C               t,pplay,u,v,zphi)   ! alt above planet average radius
    … …  
    14681468      ENDDO
    14691469
    1470       CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
     1470      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime*RDAY,
    14711471     C               ra,rg,romega,
    14721472     C               rlatd,rlond,pphis,

  • trunk/LMDZ.VENUS/libf/phyvenus/lw_venus_ve.F

    r892 r953  
    1717C
    1818c     This routine uses the NER matrix
    19 c     (computed for a given cell and temp profile in radlwsw,
    20 c      from the initial matrixes computed in load_psi)
     19c     (computed for a given cell and temp profile in radlwsw)
    2120c     to compute cooling rates and radiative fluxes.
    2221c

  • trunk/LMDZ.VENUS/libf/phyvenus/lwi.F

    r892 r953  
    11      subroutine lwi(nl,netrad,deltapsi,deltap,temp,coolrate)
    22
    3 c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4 c §§§§!!!  VERSION utilisable avec load_psi, 
    5 c          differente des versions *.1mat 
    6 c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    73      use dimphy
    84      implicit none

  • trunk/LMDZ.VENUS/libf/phyvenus/newstart.F

    r927 r953  
    134134      integer, dimension(4) :: start,counter
    135135      REAL phisinverse(iip1,jjp1)  ! geopotentiel au sol avant inversion
    136       logical topoflag,albedoflag
     136      logical topoflag,albedoflag,razvitu
    137137      real    albedo
    138138     
    … …  
    10401040      teta(iip1,:,:) =  teta(1,:,:)
    10411041
     1042! RESETING U TO 0: may be done through run.def
     1043       razvitu = . FALSE .
     1044       CALL getin('razvitu',razvitu)
     1045
    10421046c calcul des champ de vent; passage en vent covariant
    10431047      write (*,*) 'uold ', uold (1,2,1)  ! INFO
    … …  
    10561060     &                   rlonuold,rlatvold,rlonu,rlatv)
    10571061      call scal_wind(us,vs,unat,vnat)
     1062! Reseting u=0
     1063      if (razvitu) then
     1064           unat(:,:,:) = 0.
     1065      endif
    10581066      write (*,*) 'unat ', unat (1,2,1)    ! INFO
    10591067      do l=1,llm

  • trunk/LMDZ.VENUS/libf/phyvenus/physiq.F

    r892 r953  
    3333c lafin---input-L-variable logique indiquant le dernier passage
    3434c rjour---input-R-numero du jour de l'experience
    35 c gmtime--input-R-temps universel dans la journee (0 a RDAY s)
     35c gmtime--input-R-fraction de la journee (0 a 1)
    3636c pdtphys-input-R-pas d'integration pour la physique (seconde)
    3737c paprs---input-R-pression pour chaque inter-couche (en Pa)
    … …  
    10871087c====================================================================
    10881088      if (ballons.eq.1) then
    1089          CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond,
     1089         CALL ballon(30,pdtphys,rjourvrai,gmtime*RDAY,rlatd,rlond,
    10901090c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
    10911091     C               t,pplay,u,v,zphi)   ! alt above planet average radius
    … …  
    11191119      ENDDO
    11201120
    1121       CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
     1121      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime*RDAY,
    11221122     C               ra,rg,romega,
    11231123     C               rlatd,rlond,pphis,

  • trunk/LMDZ.VENUS/libf/phyvenus/radlwsw.F

    r892 r953  
    5757      REAL swnet(klon,klev+1),lwnet(klon,klev+1)
    5858c
    59       INTEGER k, kk, i, j, nb_gr
     59      INTEGER k, kk, i, j, band
    6060c
    6161      REAL   PPB(klev+1)
    … …  
    7171cIM END
    7272      real,save,allocatable :: ksive(:,:,:,:) ! ksi matrixes in Vincent's file
    73       real    psimap(0:klev+1,0:klev+1,klon)
    74       real    deltapsimap(0:klev+1,0:klev+1,klon)
     73      real,save,allocatable :: ztop(:) ! in km
     74
    7575      real    psi(0:klev+1,0:klev+1)
    7676      real    deltapsi(0:klev+1,0:klev+1)
    7777      real    latdeg
    78       real    pt0(klon,0:klev+1)
    79       real,save,allocatable :: ztop(:) ! in km
     78      real    pt0(0:klev+1)
     79      real    bplck(0:klev+1,nnuve)    ! Planck luminances in table layers
     80      real    y(0:klev,nnuve)          ! intermediaire Planck
     81      real    zdblay(0:klev+1,nnuve)   ! gradient en temperature de planck
     82      integer mat,mat0
     83      real    factp,factz,ksi
    8084
    8185      logical firstcall
    … …  
    8387      save    firstcall
    8488     
    85 c-------------------------------------------
    86       nb_gr = klon
    8789c-------------------------------------------
    8890c  Initialisations
    … …  
    116118
    117119      endif ! firstcall
    118 
    119       DO i = 1, klon
    120           pt0(i,0)  = tsol(i)
    121           DO k = 1, klev
    122             pt0(i,k) = t(i,k)
    123           ENDDO
    124           pt0(i,klev+1) = 0.
    125       ENDDO !i
    126 
    127       call load_psi(paprs(:,1),ztop,ksive,pt0,psimap,deltapsimap)
     120c-------------------------------------------
    128121
    129122      DO k = 1, klev
    130       DO i = 1, klon
     123       DO i = 1, klon
    131124         heat(i,k)=0.
    132125         cool(i,k)=0.
     126       ENDDO
    133127      ENDDO
    134       ENDDO
    135 c
     128
    136129c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
    137       DO 99999 j = 1, nb_gr
    138  
     130      DO 99999 j = 1, klon
     131
     132c======================================================================
     133c  Initialisations
     134c ---------------
     135
    139136       DO k = 1, klev
    140137        zheat(k) = 0.0
    … …  
    154151         zrmu0 = rmu0(j)
    155152 
    156       DO k = 1, klev+1
     153       DO k = 1, klev+1
    157154         PPB(k) = paprs(j,k)/1.e5
    158       ENDDO
     155       ENDDO
     156
     157       pt0(0)  = tsol(j)
     158       DO k = 1, klev
     159         pt0(k) = t(j,k)
     160       ENDDO
     161       pt0(klev+1) = 0.
    159162 
    160       DO k = 0,klev+1
    161       DO i = 0,klev+1
    162         psi(i,k) = psimap(i,k,j)
    163         deltapsi(i,k) = deltapsimap(i,k,j)
    164       ENDDO
    165       ENDDO
     163       DO k = 0,klev+1
     164       DO i = 0,klev+1
     165        psi(i,k) = 0.   ! positif quand nrj de i->k
     166        deltapsi(i,k) = 0.
     167       ENDDO
     168       ENDDO
    166169       
     170c======================================================================
     171c Getting psi and deltapsi
     172c ------------------------
     173
     174c Planck function
     175c ---------------
     176      do band=1,nnuve
     177        do k=0,klev
     178c B(T,l) = al/(exp(bl/T)-1)
     179         y(k,band) = exp(bl(band)/pt0(k))-1.
     180         bplck(k,band) = al(band)/(y(k,band))
     181         zdblay(k,band)= al(band)*bl(band)*exp(bl(band)/pt0(k))/
     182     .                  ((pt0(k)*pt0(k))*(y(k,band)*y(k,band)))
     183        enddo
     184        bplck(klev+1,band) = 0.0
     185        zdblay(klev+1,band)= 0.0
     186      enddo
     187
     188c finding the right matrixes
     189c --------------------------
     190       mat0 = 0
     191       do mat=1,nbmat-nbztopve
     192         if (  (psurfve(mat).ge.paprs(j,1))
     193     .    .and.(psurfve(mat+nbztopve).lt.paprs(j,1))
     194     .    .and.(ztopve(mat).lt.ztop(j))
     195     .    .and.(ztopve(mat+1).ge.ztop(j)) ) then
     196              mat0  = mat
     197c             print*,'ig=',j,'  mat0=',mat
     198              factp = (paprs(j,1)           -psurfve(mat))
     199     .               /(psurfve(mat+nbztopve)-psurfve(mat))
     200              factz = (ztop(j)      -ztopve(mat))
     201     .               /(ztopve(mat+1)-ztopve(mat))
     202              exit
     203         endif
     204       enddo
     205       if (mat0.eq.0) then
     206         write(*,*) 'Finding the right matrix in radlwsw'
     207         print*,'Probleme pour interpolation au point ig=',j
     208         print*,'psurf = ',paprs(j,1),' ztop = ',ztop(j)
     209         stop
     210       endif
     211
     212c interpolation of ksi and computation of psi,deltapsi
     213c ----------------------------------------------------
     214       do band=1,nnuve
     215        do k=0,klev+1
     216         do i=0,klev+1
     217          ksi = ksive(i,k,band,mat0)*(1-factz)*(1-factp)
     218     .         +ksive(i,k,band,mat0+1)*factz  *(1-factp)
     219     .         +ksive(i,k,band,mat0+nbztopve)*(1-factz)*factp
     220     .         +ksive(i,k,band,mat0+nbztopve+1)*factz  *factp
     221          psi(i,k) = psi(i,k) +
     222     .               ksi*(bplck(i,band)-bplck(k,band))
     223          deltapsi(i,k) = deltapsi(i,k) + ksi*zdblay(i,band)
     224         enddo
     225        enddo
     226       enddo
     227
    167228c======================================================================
    168229c LW call
Note: See TracChangeset for help on using the changeset viewer.