Ignore:
Timestamp:
01/09/14 09:56:11 (10 years ago)
Author:
ymipsl
Message:

Add new openMP parallelism based on distribution of domains on threads. There is no more limitation of number of threads by MPI process.

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/physics_dry.f90

    r149 r186  
    1         MODULE physics_dry_mod 
    2   USE ICOSA 
    3   PUBLIC init_physics_dry, physics_dry 
    4  
    5 CONTAINS 
    6  
    7    SUBROUTINE init_physics_dry 
    8       USE ICOSA !sarvesh 
    9       USE time_mod !sarvesh  
    10       USE dimphys_mod 
    11       USE RADIATION 
    12  
    13       IMPLICIT NONE 
    14       INTEGER::i,j,ij 
    15 !-------------------------------------- ORBITAL PARAMETER---- 
    16     periheli=150. 
    17     CALL getin('periheli', periheli) 
    18     aphelie=150. 
    19     CALL getin('aphelie',aphelie)  
    20     coefir=0.08 
    21     CALL getin('coefir',coefir) 
    22     coefvis=0.99 
    23     CALL getin('coefvis',coefvis) 
    24     obliquit=0.0 
    25     CALL getin('obliquit',obliquit)  
    26     peri_day=0. 
    27     CALL getin('peri_day',peri_day) 
    28     year_day=360. 
    29     CALL getin('year_day',year_day)  
    30     callrad=.true. 
    31     CALL getin('callrad', callrad) 
    32     calldifv=.true. 
    33     CALL getin('calldifv', calldifv) 
    34     calladj=.true. 
    35     CALL getin('calladj', calladj) 
    36     callcond=.true. 
    37     callsoil=.true. 
    38     CALL getin('callsoil',callsoil) 
    39     season=.true. 
    40     CALL getin('season',season) 
    41     diurnal=.true. 
    42     CALL getin('diurnal',diurnal) 
    43     lverbose=.false. 
    44     CALL getin('lverbose',lverbose) 
    45     period_sort=1. 
    46    CALL getin('period_sort',period_sort) 
    47 !    ptimestep=dt 
    48 !   CALL getin('ptimestep',ptimestep)  
    49  
    50       print*,'Activation de la physique:' 
    51       print*,' Rayonnement ',callrad 
    52       print*,' Diffusion verticale turbulente ', calldifv 
    53       print*,' Ajustement convectif ',calladj 
    54       print*,' Sol ',callsoil 
    55       print*,' Cycle diurne ',diurnal 
    56 !      choice of the frequency of the computation of radiations 
    57       IF(diurnal) THEN 
    58          iradia=NINT(daysec/(20.*dt)) 
    59       ELSE 
    60          iradia=NINT(daysec/(4.*dt)) 
    61       ENDIF 
    62       iradia=1 
    63  
    64       ngridmx=iim*jjm ; nlayermx=llm 
    65         offset=halo 
    66  
    67       ALLOCATE(albedo(ngridmx));ALLOCATE(emissiv(ngridmx)) 
    68       ALLOCATE(inertie(ngridmx));ALLOCATE(z0(ngridmx)) 
    69       ALLOCATE(rnatur(ngridmx));ALLOCATE(tsurf(ngridmx)) 
    70       ALLOCATE(tsoil(ngridmx,nlayermx));ALLOCATE(fluxgrd(ngridmx)) 
    71       ALLOCATE(fluxrad(ngridmx));ALLOCATE(dtrad(ngridmx,llm+1)) 
    72       ALLOCATE(q2(ngridmx,llm+1));ALLOCATE(q2l(ngridmx,llm+1)) 
    73       ALLOCATE(capcal(ngridmx)) 
    74  
    75       CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit) 
    76  
    77       PRINT*,'unjours',daysec 
    78       PRINT*,'The radiative transfer is computed each ', iradia,' physical time-step or each ', & 
    79               iradia*dt,' seconds' 
    80   END SUBROUTINE init_physics_dry 
    81  
    82  
    83   SUBROUTINE physics_dry( it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
    84   USE icosa 
    85   IMPLICIT NONE 
    86     INTEGER,INTENT(IN)    :: it 
    87     REAL(rstd),INTENT(IN) :: jD_cur,jH_cur 
    88     TYPE(t_field),POINTER :: f_phis(:) 
    89     TYPE(t_field),POINTER :: f_ps(:) 
    90     TYPE(t_field),POINTER :: f_theta_rhodz(:) 
    91     TYPE(t_field),POINTER :: f_ue(:) 
    92     TYPE(t_field),POINTER :: f_q(:) 
    93    
    94     REAL(rstd),POINTER :: phis(:) 
    95     REAL(rstd),POINTER :: ps(:) 
    96     REAL(rstd),POINTER :: theta_rhodz(:,:) 
    97     REAL(rstd),POINTER :: ue(:,:) 
    98     REAL(rstd),POINTER :: q(:,:,:) 
    99 !    REAL(rstd),POINTER :: precl(:) 
    100     INTEGER :: ind 
    101 !    LOGICAL:: firstcall,lastcall 
    102  
    103     CALL transfert_request(f_ue,req_e1_vect) 
    104     CALL transfert_request(f_theta_rhodz,req_i1) 
    105  
    106     DO ind=1,ndomain 
    107       CALL swap_dimensions(ind) 
    108       CALL swap_geometry(ind) 
    109       phis=f_phis(ind) 
    110       ps=f_ps(ind) 
    111       theta_rhodz=f_theta_rhodz(ind) 
    112       ue=f_ue(ind) 
    113       q=f_q(ind) 
    114 !      out_i=f_out_i(ind) 
    115 !      precl=f_precl(ind)  
    116 !     print*,"====================================ind",ind,"----------it",it 
    117       CALL compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q(:,:,1)) 
    118      ENDDO       
    119  
    120 !    CALL writefield("out_i",f_out_i) 
    121      
    122 !    IF (mod(it,itau_out)==0 ) THEN 
    123 !      CALL writefield("precl",f_precl) 
    124 !    ENDIF 
    125  
    126   END SUBROUTINE physics_dry 
    127    
    128   SUBROUTINE compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q) 
    129   USE icosa 
    130   USE pression_mod 
    131   USE exner_mod 
    132   USE theta2theta_rhodz_mod 
    133   USE geopotential_mod 
    134   USE wind_mod 
    135   USE PHY 
    136    
    137   IMPLICIT NONE 
    138     INTEGER::it 
    139     REAL(rstd) :: jD_cur 
    140     REAL(rstd) :: jH_cur 
    141     REAL(rstd) :: phis(iim*jjm) 
    142     REAL(rstd) :: ps(iim*jjm) 
    143     REAL(rstd) :: theta_rhodz(iim*jjm,llm) 
    144     REAL(rstd) :: ue(3*iim*jjm,llm) 
    145     REAL(rstd) :: q(iim*jjm,llm) 
    146 !    REAL(rstd) :: precl(iim*jjm) 
    147  
    148     REAL(rstd) :: p(iim*jjm,llm+1) 
    149     REAL(rstd) :: pks(iim*jjm) 
    150     REAL(rstd) :: pk(iim*jjm,llm) 
    151     REAL(rstd) :: phi(iim*jjm,llm) 
    152     REAL(rstd) :: T(iim*jjm,llm) 
    153     REAL(rstd) :: Tfi(iim*jjm,llm) 
    154     REAL(rstd) :: theta(iim*jjm,llm) 
    155  
    156    REAL(rstd) :: uc(iim*jjm,3,llm) 
    157    REAL(rstd) :: u(iim*jjm,llm) 
    158    REAL(rstd) :: v(iim*jjm,llm) 
    159     REAL(rstd) :: ufi(iim*jjm,llm) 
    160     REAL(rstd) :: vfi(iim*jjm,llm) 
    161     REAL(rstd) :: qfi(iim*jjm,llm) 
    162     REAL(rstd) :: utemp(iim*jjm,llm) 
    163     REAL(rstd) :: vtemp(iim*jjm,llm) 
    164     REAL(rstd) :: lat(iim*jjm) 
    165     REAL(rstd) :: lon(iim*jjm) 
    166     REAL(rstd) :: pmid(iim*jjm,llm) 
    167     REAL(rstd) :: pint(iim*jjm,llm+1) 
    168     REAL(rstd) :: pdel(iim*jjm,llm) 
    169     REAL(rstd) :: plev(iim*jjm,llm+1),play(iim*jjm,llm)  
    170     REAL(rstd) :: pkbycp 
    171     INTEGER :: i,j,l,ij,ig 
    172          
    173 !------------------- 
    174 !    LOGICAL:: firstcall,lastcall 
    175     REAL(rstd) :: dufi(iim*jjm,llm) 
    176     REAL(rstd) :: dvfi(iim*jjm,llm) 
    177     REAL(rstd) :: dTfi(iim*jjm,llm) 
    178     REAL(rstd) :: dpsfi(iim*jjm) 
    179     REAL(rstd) :: dqfi(iim*jjm,llm) 
    180 !    PRINT *,'Entering in LMD SIMPLE physics'     
    181  
    182  
    183         offset=halo  
    184     CALL compute_pression(ps,p,halo) 
    185     CALL compute_exner(ps,p,pks,pk,halo) 
    186     CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,halo) 
    187     CALL compute_geopotential(phis,pks,pk,theta,phi,halo) 
    188     CALL compute_theta_rhodz2temperature(ps,theta_rhodz,T,halo) 
    189     CALL compute_wind_centered(ue,uc) 
    190     CALL compute_wind_centered_lonlat_compound(uc, u, v) 
    191  
    192      DO j=jj_begin-offset,jj_end+offset 
    193       DO i=ii_begin-offset,ii_end+offset 
    194         ij=(j-1)*iim+i 
    195         CALL xyz2lonlat(xyz_i(ij,:),lon(ij),lat(ij))  
    196       ENDDO 
    197      ENDDO       
    198     
    199     DO l=1,llm 
    200       DO j=jj_begin-offset,jj_end+offset 
    201         DO i=ii_begin-offset,ii_end+offset 
    202           ij=(j-1)*iim+i 
    203 !          Tfi(ij,l)=T(ij,l) 
    204 !          ufi(ij,l)=u(ij,l) 
    205 !          vfi(ij,l)=v(ij,l) 
    206 !          qfi(ij,l)=q(ij,l) 
    207           dTfi(ij,l)=0.0 
    208           dufi(ij,l)=0.0 
    209           dvfi(ij,l)=0.0 
    210           dqfi(ij,l)=0.0 
    211         ENDDO 
    212       ENDDO 
    213     ENDDO     
    214         plev(:,:) = p(:,:)   
    215         dpsfi=0.0   
    216  
    217    DO l=1,llm 
    218      DO j=jj_begin-offset,jj_end+offset 
    219        DO i=ii_begin-offset,ii_end+offset 
    220           ij=(j-1)*iim+i 
    221           pkbycp=pk(ij,l)/cpp 
    222           play(ij,l)=preff*pkbycp**(1./kappa)  
    223         ENDDO 
    224       ENDDO 
    225      ENDDO  
    226  
    227  
    228       CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, & 
    229       plev,play,phi,phis,u,v,T,q,dufi,dvfi,dTfi,dqfi,dpsfi)  
    230  
    231       CALL ADDFI(u,v,T,q,ps,dufi,dvfi,dTfi,dqfi,dpsfi) 
    232  
    233 !       CALL SARCHECKF(llm) 
    234 !       print*,"plev",(maxval(plev(:,l)),l=1,llm+1)  
    235  
    236 !      CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, & 
    237 !      plev,play,phi,phis,ufi,vfi,Tfi,qfi,dufi,dvfi,dTfi,dqfi,dpsfi)  
    238  
    239 !               Print*,"going ADD FI",it 
    240 !      CALL ADDFI(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi) 
    241  
    242 !       WRITE(11,*)"ducovfi",maxval(dufi),minval(dufi),it 
    243 !       WRITE(11,*)"ucovfi",maxval(ufi),minval(ufi) 
    244 !       WRITE(11,*)"dtetafi",maxval(dTfi),minval(dTfi) 
    245  
    246 !============================================= 
    247 !       go to 1234 
    248     DO l=1,llm 
    249       DO j=jj_begin-offset,jj_end+offset 
    250         DO i=ii_begin-offset,ii_end+offset 
    251           ij=(j-1)*iim+i 
    252           uc(ij,:,l)=(dufi(ij,l)*elon_i(ij,:)+dvfi(ij,l)*elat_i(ij,:))*dt 
    253         ENDDO 
    254       ENDDO 
    255     ENDDO 
    256  
    257      
    258     DO l=1,llm 
    259       DO j=jj_begin-offset,jj_end+offset 
    260         DO i=ii_begin-offset,ii_end+offset 
    261           ij=(j-1)*iim+i 
    262           ue(ij+u_right,l)=ue(ij+u_right,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:) ) 
    263           ue(ij+u_lup,l)=ue(ij+u_lup,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) ) 
    264           ue(ij+u_ldown,l)=ue(ij+u_ldown,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) ) 
    265         ENDDO 
    266       ENDDO 
    267     ENDDO 
    268 !1234    continue 
    269     
    270 !   CALL compute_temperature2theta_rhodz(ps,Tfi,theta_rhodz,halo) 
    271    CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,halo) 
    272  
    273 !       WRITE(13,*)"tetafi",maxval(theta_rhodz),minval(theta_rhodz) 
    274     RETURN    
    275   END SUBROUTINE compute_physics_dry 
    276  
    277     SUBROUTINE addfi(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi) 
    278         USE ICOSA 
    279         IMPLICIT NONE 
    280           REAL(rstd) :: dufi(iim*jjm,llm) 
    281           REAL(rstd) :: dvfi(iim*jjm,llm) 
    282         REAL(rstd) :: dTfi(iim*jjm,llm) 
    283         REAL(rstd) :: dpsfi(iim*jjm) 
    284         REAL(rstd) :: dqfi(iim*jjm,llm) 
    285         REAL(rstd) :: ufi(iim*jjm,llm) 
    286         REAL(rstd) :: vfi(iim*jjm,llm) 
    287         REAL(rstd) :: qfi(iim*jjm,llm) 
    288           REAL(rstd) :: ps(iim*jjm) 
    289           REAL(rstd) :: Tfi(iim*jjm,llm) 
    290           INTEGER::i,j,l,ij,offset 
    291                 offset=halo 
    292          
    293      DO l=1,llm 
    294       DO j=jj_begin-offset,jj_end+offset 
    295         DO i=ii_begin-offset,ii_end+offset 
    296           ij=(j-1)*iim+i 
    297           Tfi(ij,l)=Tfi(ij,l)+dTfi(ij,l)*dt 
    298           ufi(ij,l)=ufi(ij,l)+dufi(ij,l)*dt  
    299           vfi(ij,l)=vfi(ij,l)+dvfi(ij,l)*dt  
    300           qfi(ij,l)=qfi(ij,l)+dqfi(ij,l)*dt   
    301         END DO 
    302       END DO 
    303      END DO   
    304          ps(:)=ps(:) + dpsfi(:)*dt 
    305         END SUBROUTINE addfi  
    306     
    307 END MODULE physics_dry_mod 
Note: See TracChangeset for help on using the changeset viewer.