Ignore:
Timestamp:
Jun 4, 2007, 4:34:47 PM (17 years ago)
Author:
Laurent Fairhead
Message:

Merge entre la version V3_conv et le HEAD
YM, JG, LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/phytrac.F

    r682 r766  
    6363
    6464      USE ioipsl
    65 
    66 #ifdef INCA
    67       USE sflx
    68       USE chem_tracnm
    69       USE species_names
    70       USE chem_mods
    71 #ifdef INCA_NMHC
    72       USE pht_tables, ONLY : jrates
    73       USE lightning, ONLY : prod_light
    74 #endif
    75 #ifdef INCA_CH4
    76       USE pht_tables, ONLY : jrates
    77       USE lightning, ONLY : prod_light
    78 #endif
    79       USE transport_controls, ONLY : conv_flg, pbl_flg
    80       USE airplane_src, ONLY : ptrop
    81 #ifdef INCA_AER
    82       USE AEROSOL_MOD, only : ntr,trmx,trnx
    83       USE AEROSOL_DIAG,only : cla,las,tausum,angst,aload,cload,totaerh2o,tau,
    84      $  emiss20,sconc,scavcoef_st,scavcoef_cv
    85      $  ,cload05ss  ,cload05bc  ,cload05pom  ,cload05dust  ,cload05so4
    86      $  ,cload125ss  ,cload125bc  ,cload125pom  ,cload125dust  ,cload125so4
    87       USE AEROSOL_PROGNOS, ONLY : md,mdw
    88       USE AEROSOL_METEO, only : airm
    89 #endif
    90 #ifdef INCA_NMHC
    91       USE RESISTANCE_DIAGNOSE, ONLY : surf_alb, sol_irrad, surf_temp, surf_wind,
    92      $                                aero_resist, lamin_resist, surf_resist
    93 #endif
    94 #endif
     65      USE dimphy
     66      USE comgeomphy
     67      USE iophy
     68      USE vampir
     69
    9570      IMPLICIT none
    9671c======================================================================
    … …  
    10883#include "YOMCST.h"
    10984#include "dimensions.h"
    110 #include "dimphy.h"
     85cym#include "dimphy.h"
    11186#include "indicesol.h"
    11287#include "clesphys.h"
    … …  
    11489#include "paramet.h"
    11590#include "control.h"
    116 #include "comgeomphy.h"
     91cym#include "comgeomphy.h"
    11792#include "advtrac.h"
    11893#include "thermcell.h"
    … …  
    162137#ifdef INCA
    163138      REAL flxmass_w(klon,klev)
     139      CHARACTER(len=8) :: solsym(nqmax)
    164140#endif
    165141c      integer iflag_con
    … …  
    227203cAA Pour l'instant seuls les cas du rn et du pb ont ete envisages.
    228204
    229       REAL source(klon)       ! a voir lorsque le flux est prescrit
     205      REAL source(klon,nqmax)       ! a voir lorsque le flux est prescrit
    230206cAA
    231207cAA Pour la source de radon et son reservoir de sol
    232208cAA ................................................
    233209 
    234       REAL trs(klon,nbtr)    ! Conc. radon ds le sol
    235       SAVE trs
    236 
    237       REAL masktr(klon,nbtr) ! Masque reservoir de sol traceur
     210      REAL,save,allocatable :: trs(:,:)    ! Conc. radon ds le sol
     211c$OMP THREADPRIVATE(trs)
     212cym      SAVE trs
     213      REAL :: trs_tmp(klon2)
     214      REAL,SAVE,ALLOCATABLE :: trs_mpi(:)
     215     
     216      REAL,save,allocatable :: masktr(:,:) ! Masque reservoir de sol traceur
    238217c                            Masque de l'echange avec la surface
    239218c                           (1 = reservoir) ou (possible => 1 )
    240       SAVE masktr
    241       REAL fshtr(klon,nbtr)  ! Flux surfacique dans le reservoir de sol
    242       SAVE fshtr
    243       REAL hsoltr(nbtr)      ! Epaisseur equivalente du reservoir de sol
    244       SAVE hsoltr
    245       REAL tautr(nbtr)       ! Constante de decroissance radioactive
    246       SAVE tautr
    247       REAL vdeptr(nbtr)      ! Vitesse de depot sec dans la couche Brownienne
    248       SAVE vdeptr
    249       REAL scavtr(nbtr)      ! Coefficient de lessivage
    250       SAVE scavtr
     219c$OMP THREADPRIVATE(masktr)
     220cym      SAVE masktr
     221      REAL,save,allocatable :: fshtr(:,:)  ! Flux surfacique dans le reservoir de sol
     222c$OMP THREADPRIVATE(fshtr)
     223cym      SAVE fshtr
     224      REAL,save,allocatable :: hsoltr(:)      ! Epaisseur equivalente du reservoir de sol
     225c$OMP THREADPRIVATE(hsoltr)
     226cym      SAVE hsoltr
     227      REAL,save,allocatable :: tautr(:)       ! Constante de decroissance radioactive
     228c$OMP THREADPRIVATE(tautr)
     229cym      SAVE tautr
     230      REAL,save,allocatable :: vdeptr(:)      ! Vitesse de depot sec dans la couche Brownienne
     231c$OMP THREADPRIVATE(vdeptr)
     232cym      SAVE vdeptr
     233      REAL,save,allocatable :: scavtr(:)      ! Coefficient de lessivage
     234c$OMP THREADPRIVATE(scavtr)
     235cym      SAVE scavtr
    251236cAA
    252237      CHARACTER*2 itn
    … …  
    257242      INTEGER nid_tra
    258243      SAVE nid_tra
     244c$OMP THREADPRIVATE(nid_tra)
    259245#ifdef INCA_AER
    260246      INTEGER nid_tra2,nid_tra3
    261247      SAVE nid_tra2,nid_tra3
     248c$OMP THREADPRIVATE(nid_tra2,nid_tra3)
    262249#endif
    263250c     REAL x(klon,klev,nbtr+2) ! traceurs
    264251      INTEGER ndex(1)
    265252      INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
     253      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
     254      REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
    266255      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
    267256      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
    … …  
    274263c
    275264c      INTEGER ecrit_tra
    276 c      SAVE ecrit_tra   
     265c      SAVE ecrit_tra
     266
    277267      logical ok_sync
    278268      parameter (ok_sync = .true.)
    … …  
    280270C nature du traceur
    281271c
    282       logical aerosol(nbtr)  ! Nature du traceur
     272      logical,save,allocatable :: aerosol(:)  ! Nature du traceur
    283273c                            ! aerosol(it) = true  => aerosol
    284274c                            ! aerosol(it) = false => gaz
    285275c                            ! nat_trac(it) = 1. aerosol
    286       logical clsol(nbtr)    ! clsol(it) = true => CL sol calculee
    287       logical radio(nbtr)    ! radio(it)=true => decroisssance radioactive
    288       save aerosol,clsol,radio
     276      logical,save,allocatable :: clsol(:)    ! clsol(it) = true => CL sol calculee
     277      logical,save,allocatable :: radio(:)    ! radio(it)=true => decroisssance radioactive
     278c$OMP THREADPRIVATE(aerosol,clsol,radio) 
     279cym      save aerosol,clsol,radio
    289280C
    290281c======================================================================
    … …  
    334325      save first,couchelimite,convection,lessivage,
    335326     s        sorties,inirnpb
     327c$OMP THREADPRIVATE(first,couchelimite,convection,lessivage,
     328c$OMP+              sorties,inirnpb)
    336329c      data first,couchelimite,convection,lessivage,sorties
    337330c     s     /.true.,.true.,.false.,.true.,.true./
    … …  
    345338      INTEGER           :: lastgas
    346339      INTEGER           :: ncsec
    347 
    348       INTEGER           :: prt_flag_ts(nbtr)=(/
    349 #ifdef INCA_CH4
    350      .                                         1,1,1,0,0,1,1,1,1,1,
    351      .                                         0,1,0,0,0,0,0,1,0,0,
    352      .                                         0,1,1,1,1,0,1,1,1,0,
    353      .                                         1,1,1,1,1,1,1,1,1,1,
    354      .                                         1,0,0
    355 #ifdef INCA_AER
    356      .                                        ,1,1,1,1,0,1,1,1,1,0,
    357      .                                         1,1,1,1,1,1,0,1,0,1,
    358      .                                         1,1,1,1,0,1,0,1,1,1
    359 #endif
    360 #endif
    361 #ifdef INCA_NMHC
    362      .                                         1,1,1,1,1,1,1,1,1,1,
    363      .                                         1,1,1,1,1,1,1,1,1,1,
    364      .                                         1,1,1,1,1,1,1,1,1,1,
    365      .                                         1,1,1,1,1,1,1,1,1,1,
    366      .                                         1,1,1,1,1,1,1,1,1,1,
    367      .                                         1,1,1,1,1,1,1,1,1,1,
    368      .                                         1,1,1,1,1,1,1,1,1,1,
    369      .                                         1,1,1,1,1,1,1,1,1,1,
    370      .                                         1,1,1,1,1,1,1
    371 #ifdef INCA_AER
    372      .                                        ,1,1,1,1,0,1,1,1,1,0,
    373      .                                         1,1,1,1,1,1,0,1,0,1,
    374      .                                         1,1,1,1,0,1,0,1,1,1
    375 #endif
    376 #endif
    377 #if defined(INCA_AER) && !defined(INCA_CH4) && !defined(INCA_NMHC)
    378      .                                         1,1,1,1,1,1,1,1,1,1,
    379      .                                         1,1,1,1,1,1,1,1,1,1,
    380      .                                         1,1,1,1,1,1,1,1,1
    381 #endif
    382 #if defined(INCA) && !defined(INCA_CH4) && !defined(INCA_NMHC) && !defined(INCA_AER)
    383      .                                         1,1,1,1,1,1,1,1,1,1,
    384      .                                         1                                         
    385 #endif
    386 
    387      .                                         /)
    388 
     340      INTEGER           :: prt_flag_ts(nbtr) 
    389341
    390342      REAL, PARAMETER   :: dry_mass = 28.966
    … …  
    393345      REAL              :: calday
    394346      REAL              :: pdel(klon,klev)
    395       REAL              :: dummy(klon,klev) = 0.
     347      REAL              :: dummy(klon,klev)
    396348#endif
    397349#ifdef INCA_AER
    … …  
    400352c
    401353c======================================================================
     354
     355#ifdef INCA
     356      prt_flag_ts(:)=(/
     357#ifdef INCA_CH4
     358     .             1,1,1,0,0,1,1,1,1,1,
     359     .             0,1,0,0,0,0,0,1,0,0,
     360     .             0,1,1,1,1,0,1,1,1,0,
     361     .             1,1,1,1,1,1,1,1,1,1,
     362     .             1,0,0
     363#ifdef INCA_AER
     364     .             ,1,1,1,1,0,1,1,1,1,0,
     365     .             1,1,1,1,1,1,0,1,0,1,
     366     .             1,1,1,1,0,1,0,1,1,1
     367#endif
     368#endif
     369#ifdef INCA_NMHC
     370     .             1,1,1,1,1,1,1,1,1,1,
     371     .             1,1,1,1,1,1,1,1,1,1,
     372     .             1,1,1,1,1,1,1,1,1,1,
     373     .             1,1,1,1,1,1,1,1,1,1,
     374     .             1,1,1,1,1,1,1,1,1,1,
     375     .             1,1,1,1,1,1,1,1,1,1,
     376     .             1,1,1,1,1,1,1,1,1,1,
     377     .             1,1,1,1,1,1,1,1,1,1,
     378     .             1,1,1,1,1,1,1
     379#ifdef INCA_AER
     380     .             ,1,1,1,1,0,1,1,1,1,0,
     381     .             1,1,1,1,1,1,0,1,0,1,
     382     .             1,1,1,1,0,1,0,1,1,1
     383#endif
     384#endif
     385#if defined(INCA_AER) && !defined(INCA_CH4) && !defined(INCA_NMHC)
     386     .             1,1,1,1,1,1,1,1,1,1,
     387     .             1,1,1,1,1,1,1,1,1,1,
     388     .             1,1,1,1,1,1,1,1,1
     389#endif
     390#if defined(INCA) && !defined(INCA_CH4) && !defined(INCA_NMHC) && !defined(INCA_AER)
     391     .             1,1,1,1,1,1,1,1,1,1,
     392     .             1                                         
     393#endif
     394
     395     .             /)
     396      dummy(:,:) = 0.
     397
     398#endif
    402399         modname='phytrac'
    403400
    … …  
    405402
    406403         if (debutphy) then
    407 
    408 c          ecrit_tra = NINT(86400./pdtphys *ecritphy)
     404           allocate( trs(klon,nbtr) )
     405c$OMP MASTER
     406           allocate( trs_mpi(klon_mpi) ) 
     407c$OMP END MASTER           
     408           allocate( masktr(klon,nbtr))
     409           allocate( fshtr(klon,nbtr) )
     410           allocate( hsoltr(nbtr))
     411           allocate( tautr(nbtr))
     412           allocate( vdeptr(nbtr))
     413           allocate( scavtr(nbtr))
     414           allocate( aerosol(nbtr))
     415           allocate( clsol(nbtr))
     416           allocate( radio(nbtr))
     417
     418
     419          ecrit_tra = NINT(86400./pdtphys *ecritphy)
    409420          print*,'dans phytrac ',pdtphys,ecritphy,ecrit_tra
    410421
    … …  
    435446c        print*,'valeur de debut dans phytrac :',debutphy
    436447         trs(:,:) = 0.
    437 
    438          open (99,file='starttrac',status='old',
     448c$OMP MASTER         
     449       if (phy_rank==0) then
     450         trs_tmp(:)=0.
     451         open (99,file='starttrac',status='old',
    439452     .         err=999,form='formatted')
    440          read(99,*) (trs(i,1),i=1,klon)
     453         read(99,*) (trs_tmp(i),i=1,klon2)
    441454999      close(99)
     455       endif
     456       call ScatterField(trs_tmp,trs_mpi,1)
     457c$OMP END MASTER
     458      call ScatterField_omp(trs_mpi,trs(:,1),1)
    442459c         print*, 'apres starttrac'
    443460
    … …  
    470487      endif
    471488#ifdef INCA
     489      call VTe(VTphysiq)
     490      call VTb(VTinca)
    472491!======================================================================
    473492!     Chimie
    … …  
    509528     $                 rneb,         ! for chimiaq
    510529     $                 t_seri,       ! for chimiaq
    511      $                 rh)
     530     $                 rh,
     531     $                 lafin)
    512532! fin changement anne
    513533
    … …  
    515535
    516536        CALL chemmain (tr_seri,    !mmr
    517      $                 nas,        !nas
    518537     $                 nstep,      !nstep
    519538     $                 calday,     !calday
    … …  
    550569     $                 obuf,       !obuf
    551570     $                 iip1,       !nx
    552      $                 jjp1)       !ny
     571     $                 jjp1,       !ny
     572     $                 source,
     573     $                 solsym)
    553574#ifdef INCAINFO
    554575#ifdef INCA_AER
    … …  
    582603      END DO
    583604#endif
     605      call VTe(VTinca)
     606      call VTb(VTphysiq)
    584607#else
    585608
    … …  
    755778C         CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'cltracrn it='//itn)
    756779      else ! couche limite avec flux prescrit
    757 #ifdef INCA
    758         DO k =  1, klon
    759           source(k) = eflux(k,it)-dflux(k,it)
    760         END DO
    761 #else
     780#ifndef INCA
    762781
    763782Cmaf provisoire source / traceur a creer
    764783        DO i=1, klon
    765           source(i) = 0.0 ! pas de source, pour l'instant
     784          source(i,it) = 0.0 ! pas de source, pour l'instant
    766785        ENDDO
    767786C
    768787#endif
    769788          CALL cltrac(pdtphys, coefh,t_seri,
    770      s               tr_seri(1,1,it), source,
     789     s               tr_seri(1,1,it), source(:,it),
    771790     e               paprs, pplay, delp,
    772791     s               d_tr_cl(1,1,it))
    … …  
    904923      if (lafin) then
    905924         print*, 'c est la fin de la physique'
    906          open (99,file='restarttrac',  form='formatted')
    907          do i=1,klon
    908              write(99,*) trs(i,1)
    909          enddo
    910          PRINT*, 'Ecriture du fichier restarttrac'
    911          close(99)
     925         call GatherField_omp(trs(:,1),trs_mpi,1)
     926c$OMP MASTER     
     927         call GatherField(trs_mpi,trs_tmp,1)
     928         if (phy_rank==0) then
     929         
     930           open (99,file='restarttrac',  form='formatted')
     931           do i=1,klon
     932               write(99,*) trs_tmp(i)
     933           enddo
     934           PRINT*, 'Ecriture du fichier restarttrac'
     935           close(99)
     936         endif
     937c$OMP END MASTER
    912938      else
    913939c         print*, 'physique pas fini'
Note: See TracChangeset for help on using the changeset viewer.