Changeset 327


Ignore:
Timestamp:
02/09/15 20:18:34 (9 years ago)
Author:
ymipsl
Message:

Merge recent developments from saturn branch onto trunk.

  • lmdz generic physics interface
  • performance improvment on mix mpi/openmp
  • asynchrone and overlaping communication
  • best domain distribution between process and threads
  • ....

This version is compatible with the actual saturn version and the both branches are considered merged on dynamico component.

YM

Location:
codes/icosagcm/trunk
Files:
16 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/make_icosa

    r279 r327  
    1616arch="" 
    1717parallel="none" 
     18physics="none" 
    1819CPP_KEY="CPP_NONE"  
    1920ICOSA_LIB="" 
    … …  
    4546      "-parallel") 
    4647          parallel=$2 ; parallel_defined="TRUE"; shift ; shift ;; 
     48 
     49      "-physics") 
     50          physics=$2 ; physics_defined="TRUE"; shift ; shift ;; 
    4751 
    4852      "-job") 
    … …  
    119123fi 
    120124 
     125if [[ "$physics" == "lmdz_generic" ]] 
     126then 
     127  CPP_KEY="$CPP_KEY CPP_PHYSICS_LMDZ_GENERIC" 
     128  COMPIL_FFLAGS="$COMPIL_FFLAGS $PHYSICS_INCDIR" 
     129  ICOSA_LIB="$ICOSA_LIB $PHYSICS_LIBDIR $PHYSICS_LIB" 
     130fi 
     131 
    121132if [[ "$with_xios_defined" == "TRUE" ]] 
    122133then 
    … …  
    127138 
    128139ICOSA_LIB="$ICOSA_LIB $NETCDF_LIBDIR $NETCDF_LIB $HDF5_LIBDIR $HDF5_LIB" 
     140 
    129141 
    130142rm -f config.fcm 

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

    r252 r327  
    272272  CALL trace_end("compute_gradq3d3") 
    273273   
    274   gradq3d_out=gradq3d 
     274   
     275  DO k=1,3 
     276    DO l = ll_begin,ll_end 
     277      DO ij=ij_begin,ij_end  
     278        gradq3d_out(ij,l,k)=gradq3d(ij,l,k) 
     279      ENDDO 
     280    ENDDO 
     281  ENDDO 
    275282   
    276283  CONTAINS 

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

    r295 r327  
    9595 
    9696    CALL send_message(f_u,req_u) 
     97    CALL send_message(f_wfluxt,req_wfluxt) 
     98    CALL send_message(f_q,req_q) 
     99    CALL send_message(f_rhodz,req_rhodz) 
     100 
    97101    CALL wait_message(req_u) 
    98     CALL send_message(f_wfluxt,req_wfluxt) 
    99102    CALL wait_message(req_wfluxt) 
    100     CALL send_message(f_q,req_q) 
    101103    CALL wait_message(req_q) 
    102     CALL send_message(f_rhodz,req_rhodz) 
    103104    CALL wait_message(req_rhodz) 
    104  
    105 !    CALL wait_message(req_u) 
    106 !    CALL wait_message(req_wfluxt) 
    107 !    CALL wait_message(req_q) 
    108 !    CALL wait_message(req_rhodz) 
    109105     
    110106    ! 1/2 vertical transport + back-trajectories 
    … …  
    134130 
    135131    CALL send_message(f_cc,req_cc) 
    136     CALL wait_message(req_cc) 
    137132 
    138133 
    139134    ! horizontal transport - split in two to place transfer of gradq3d 
    140 !!$OMP BARRIER 
    141135    DO k = 1, nqtot 
    142136       DO ind=1,ndomain 
    … …  
    148142          sqrt_leng=f_sqrt_leng(ind) 
    149143          CALL compute_gradq3d(q(:,:,k),sqrt_leng,gradq3d,xyz_i,xyz_v) 
     144 
    150145       END DO 
    151146 
    152147       CALL send_message(f_gradq3d,req_gradq3d) 
    153 !       CALL wait_message(req_cc) 
     148       CALL wait_message(req_cc) 
    154149       CALL wait_message(req_gradq3d) 
    155150 

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

    r295 r327  
    201201      IF(caldyn_eta==eta_mass) THEN 
    202202         CALL send_message(f_ps,req_ps)  
    203          CALL wait_message(req_ps)   
    204203      ELSE 
    205204         CALL send_message(f_mass,req_mass)  
    206          CALL wait_message(req_mass)   
    207205      END IF 
    208206 
     207    CALL send_message(f_theta_rhodz,req_theta_rhodz)  
    209208    CALL send_message(f_u,req_u) 
    210     CALL wait_message(req_u) 
    211     CALL send_message(f_theta_rhodz,req_theta_rhodz)  
    212     CALL wait_message(req_theta_rhodz)  
    213      
    214 !    CALL wait_message(req_u) 
    215 !    CALL wait_message(req_theta_rhodz)  
    216209 
    217210    SELECT CASE(caldyn_conserv) 
    … …  
    232225 
    233226       CALL send_message(f_qu,req_qu) 
    234        CALL wait_message(req_qu) 
     227!       CALL wait_message(req_qu) 
    235228 
    236229       DO ind=1,ndomain 
    … …  
    364357 
    365358  IF(caldyn_eta==eta_mass) THEN 
    366 !     CALL wait_message(req_ps)   
     359     CALL wait_message(req_ps)   
    367360  ELSE 
    368 !     CALL wait_message(req_mass) 
     361     CALL wait_message(req_mass) 
    369362  END IF 
    370 !  CALL wait_message(req_theta_rhodz)  
     363  CALL wait_message(req_theta_rhodz)  
    371364 
    372365  IF(caldyn_eta==eta_mass) THEN ! Compute mass & theta 
    373366     DO l = ll_begin,ll_end 
    374 !        CALL test_message(req_u)  
     367        CALL test_message(req_u)  
    375368!DIR$ SIMD 
    376369        DO ij=ij_begin_ext,ij_end_ext 
    … …  
    382375  ELSE ! Compute only theta 
    383376     DO l = ll_begin,ll_end 
    384 !        CALL test_message(req_u)  
     377        CALL test_message(req_u)  
    385378!DIR$ SIMD 
    386379       DO ij=ij_begin_ext,ij_end_ext 
    … …  
    390383  END IF 
    391384 
    392 !  CALL wait_message(req_u)    
     385  CALL wait_message(req_u)    
    393386   
    394387!!! Compute shallow-water potential vorticity 
    … …  
    446439    INTEGER :: i,j,ij,l 
    447440    REAL(rstd) :: p_ik, exner_ik 
     441    INTEGER,SAVE ::ij_omp_begin_ext, ij_omp_end_ext 
     442!$OMP THREADPRIVATE(ij_omp_begin_ext, ij_omp_end_ext) 
     443    LOGICAL,SAVE :: first=.TRUE. 
     444!$OMP THREADPRIVATE(first) 
     445 
    448446 
    449447    CALL trace_start("compute_geopot") 
     448     
     449    IF (first) THEN 
     450      first=.FALSE. 
     451      CALL distrib_level(ij_end_ext-ij_begin_ext+1,ij_omp_begin_ext,ij_omp_end_ext) 
     452      ij_omp_begin_ext=ij_omp_begin_ext+ij_begin_ext-1 
     453      ij_omp_end_ext=ij_omp_end_ext+ij_begin_ext-1 
     454    ENDIF 
    450455 
    451456    IF(caldyn_eta==eta_mass) THEN 
    452457 
    453458!!! Compute exner function and geopotential 
    454        IF (is_omp_level_master) THEN ! no openMP on vertical due to dependency 
    455459         DO l = 1,llm 
    456 !         !$OMP DO SCHEDULE(STATIC)  
    457460          !DIR$ SIMD 
    458             DO ij=ij_begin_ext,ij_end_ext          
     461            DO ij=ij_omp_begin_ext,ij_omp_end_ext          
    459462               p_ik = ptop + mass_ak(l) + mass_bk(l)*ps(ij) ! FIXME : leave ps for the moment ; change ps to Ms later 
    460463               !         p_ik = ptop + g*(mass_ak(l)+ mass_bk(l)*ps(i,j)) 
    … …  
    465468          ENDDO 
    466469         ENDDO 
    467        ENDIF 
     470!       ENDIF 
    468471    ELSE  
    469472       ! We are using a Lagrangian vertical coordinate 
    … …  
    474477       IF(boussinesq) THEN ! compute only geopotential : pressure pk will be computed in compute_caldyn_horiz 
    475478          ! specific volume 1 = dphi/g/rhodz 
    476          IF (is_omp_level_master) THEN ! no openMP on vertical due to dependency 
    477            DO l = 1,llm 
    478 !             !$OMP DO SCHEDULE(STATIC)  
    479              !DIR$ SIMD 
    480              DO ij=ij_begin_ext,ij_end_ext          
    481                 geopot(ij,l+1) = geopot(ij,l) + g*rhodz(ij,l) 
    482              ENDDO 
     479!         IF (is_omp_level_master) THEN ! no openMP on vertical due to dependency 
     480         DO l = 1,llm 
     481           !DIR$ SIMD 
     482           DO ij=ij_omp_begin_ext,ij_omp_end_ext          
     483              geopot(ij,l+1) = geopot(ij,l) + g*rhodz(ij,l) 
    483484           ENDDO 
    484          ENDIF 
     485         ENDDO 
    485486       ELSE ! non-Boussinesq, compute geopotential and Exner pressure 
    486487          ! uppermost layer 
    487          IF (is_omp_level_master) THEN  ! no openMP on vertical due to dependency 
    488  
     488 
     489         !DIR$ SIMD 
     490         DO ij=ij_omp_begin_ext,ij_omp_end_ext          
     491            pk(ij,llm) = ptop + (.5*g)*rhodz(ij,llm) 
     492         END DO 
     493         ! other layers 
     494         DO l = llm-1, 1, -1 
     495            !DIR$ SIMD 
     496            DO ij=ij_omp_begin_ext,ij_omp_end_ext          
     497               pk(ij,l) = pk(ij,l+1) + (.5*g)*(rhodz(ij,l)+rhodz(ij,l+1)) 
     498            END DO 
     499         END DO 
     500        ! surface pressure (for diagnostics) 
     501         DO ij=ij_omp_begin_ext,ij_omp_end_ext          
     502            ps(ij) = pk(ij,1) + (.5*g)*rhodz(ij,1) 
     503         END DO 
     504 
     505         ! specific volume v = kappa*theta*pi/p = dphi/g/rhodz 
     506         DO l = 1,llm 
    489507           !DIR$ SIMD 
    490            DO ij=ij_begin_ext,ij_end_ext          
    491               pk(ij,llm) = ptop + (.5*g)*rhodz(ij,llm) 
    492            END DO 
    493            ! other layers 
    494            DO l = llm-1, 1, -1 
    495  
    496 !           !$OMP DO SCHEDULE(STATIC)  
    497               !DIR$ SIMD 
    498               DO ij=ij_begin_ext,ij_end_ext          
    499                  pk(ij,l) = pk(ij,l+1) + (.5*g)*(rhodz(ij,l)+rhodz(ij,l+1)) 
    500               END DO 
    501            END DO 
    502           ! surface pressure (for diagnostics) 
    503            DO ij=ij_begin_ext,ij_end_ext          
    504               ps(ij) = pk(ij,1) + (.5*g)*rhodz(ij,1) 
    505            END DO 
    506  
    507           ! specific volume v = kappa*theta*pi/p = dphi/g/rhodz 
    508            DO l = 1,llm 
    509  
    510 !             !$OMP DO SCHEDULE(STATIC)  
    511              !DIR$ SIMD 
    512               DO ij=ij_begin_ext,ij_end_ext          
    513                  p_ik = pk(ij,l) 
    514                  exner_ik = cpp * (p_ik/preff) ** kappa 
    515                  geopot(ij,l+1) = geopot(ij,l) + (g*kappa)*rhodz(ij,l)*theta(ij,l)*exner_ik/p_ik  
    516                  pk(ij,l) = exner_ik 
    517               ENDDO 
     508            DO ij=ij_omp_begin_ext,ij_omp_end_ext          
     509               p_ik = pk(ij,l) 
     510               exner_ik = cpp * (p_ik/preff) ** kappa 
     511               geopot(ij,l+1) = geopot(ij,l) + (g*kappa)*rhodz(ij,l)*theta(ij,l)*exner_ik/p_ik  
     512               pk(ij,l) = exner_ik 
    518513            ENDDO 
    519           ENDIF 
     514          ENDDO 
    520515       END IF 
    521516 
    … …  
    562557  DO l = ll_begin, ll_end 
    563558!!!  Compute mass and theta fluxes 
    564 !    IF (caldyn_conserv==energy) CALL test_message(req_qu)  
     559    IF (caldyn_conserv==energy) CALL test_message(req_qu)  
    565560!DIR$ SIMD 
    566561    DO ij=ij_begin_ext,ij_end_ext          
    … …  
    602597    CASE(energy) ! energy-conserving TRiSK 
    603598 
    604 !       CALL wait_message(req_qu) 
     599       CALL wait_message(req_qu) 
    605600 
    606601        DO l=ll_begin,ll_end 
    … …  
    796791    REAL(rstd),INTENT(INOUT) :: wflux(iim*jjm,llm+1) ! vertical mass flux (kg/m2/s) 
    797792    REAL(rstd),INTENT(INOUT) :: wwuu(iim*3*jjm,llm+1) 
    798     REAL(rstd),INTENT(OUT) :: du(iim*3*jjm,llm) 
    799     REAL(rstd),INTENT(OUT) :: dtheta_rhodz(iim*jjm,llm) 
     793    REAL(rstd),INTENT(INOUT) :: du(iim*3*jjm,llm) 
     794    REAL(rstd),INTENT(INOUT) :: dtheta_rhodz(iim*jjm,llm) 
    800795    REAL(rstd),INTENT(OUT) :: dps(iim*jjm) 
    801796 
    … …  
    803798    INTEGER :: i,j,ij,l 
    804799    REAL(rstd) :: p_ik, exner_ik 
     800    INTEGER,SAVE ::ij_omp_begin, ij_omp_end 
     801!$OMP THREADPRIVATE(ij_omp_begin, ij_omp_end) 
     802    LOGICAL,SAVE :: first=.TRUE. 
     803!$OMP THREADPRIVATE(first) 
     804 
     805 
     806    CALL trace_start("compute_geopot") 
     807     
     808    IF (first) THEN 
     809      first=.FALSE. 
     810      CALL distrib_level(ij_end-ij_begin+1,ij_omp_begin,ij_omp_end) 
     811      ij_omp_begin=ij_omp_begin+ij_begin-1 
     812      ij_omp_end=ij_omp_end+ij_begin-1 
     813    ENDIF 
    805814 
    806815!    REAL(rstd) :: wwuu(iim*3*jjm,llm+1) ! tmp var, don't know why but gain 30% on the whole code in opemp 
    … …  
    812821!$OMP BARRIER    
    813822!!! cumulate mass flux convergence from top to bottom 
    814   IF (is_omp_level_master) THEN 
     823!  IF (is_omp_level_master) THEN 
    815824    DO  l = llm-1, 1, -1 
    816825!    IF (caldyn_conserv==energy) CALL test_message(req_qu)  
    … …  
    818827!!$OMP DO SCHEDULE(STATIC)  
    819828!DIR$ SIMD 
    820       DO ij=ij_begin,ij_end          
     829      DO ij=ij_omp_begin,ij_omp_end          
    821830          convm(ij,l) = convm(ij,l) + convm(ij,l+1) 
    822831      ENDDO 
    823832    ENDDO 
    824   ENDIF 
     833!  ENDIF 
    825834 
    826835!$OMP BARRIER 

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

    r295 r327  
    1414    TYPE(t_field), POINTER :: field(:) 
    1515    INTEGER :: intval(2) 
    16     INTEGER :: ind,i,j,ij,l 
     16    INTEGER :: ind,i,j,ij,l,k 
    1717    INTEGER :: tot_sum 
    1818         
    … …  
    4949          ENDDO 
    5050        ENDDO 
     51 
     52      ELSE IF (field(ind)%ndim==4) THEN 
     53         
     54        DO k=1,size(field(ind)%rval4d,3) 
     55          DO l=1,size(field(ind)%rval4d,2) 
     56            DO j=jj_begin,jj_end 
     57               DO i=ii_begin,ii_end 
     58                  ij=(j-1)*iim+i 
     59                  IF (domain(ind)%own(i,j)) THEN 
     60                    intval=transfer(field(ind)%rval4d(ij,l,k),intval,2)   
     61                    tot_sum=tot_sum+intval(1)+intval(2) 
     62                  ENDIF 
     63               ENDDO 
     64            ENDDO 
     65          ENDDO 
     66        ENDDO 
    5167      
    5268      ENDIF 
    … …  
    5672     
    5773!$OMP MASTER 
    58     PRINT*,"CheckSum Field",field(1)%name,tot_sum 
     74    PRINT*,"CheckSum Field : ",field(1)%name,tot_sum 
    5975!$OMP END MASTER 
    6076   

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

    r295 r327  
    402402  SUBROUTINE assign_domain 
    403403  USE mpipara 
     404  USE grid_param 
    404405  IMPLICIT NONE 
    405406    INTEGER :: nb_domain(0:mpi_size-1) 
    406407    INTEGER :: rank, ind,ind_glo 
     408    INTEGER :: block_j,jb,i,j,nd_glo,n,nf 
     409    LOGICAL :: exit 
    407410     
    408411    DO rank=0,mpi_size-1 
    … …  
    415418    ALLOCATE(domloc_glo_ind(ndomain)) 
    416419     
     420     
     421    block_j=sqrt(nsplit_i*nsplit_j*nb_face*1./mpi_size) 
     422    exit=.FALSE. 
     423    jb=1 
     424    i=1 
     425    j=1 
     426    ind=1 
     427    nd_glo=0 
    417428    rank=0 
    418     ind=0 
    419     DO ind_glo=1,ndomain_glo 
    420       ind=ind+1 
     429    DO WHILE (.NOT. exit) 
     430 
     431      IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN 
     432        j=jb 
     433        i=i+1 
     434      ENDIF 
     435 
     436      IF (i>nsplit_i) THEN  
     437        i=1 
     438        jb=jb+block_j 
     439        j=jb 
     440      ENDIF 
     441       
     442      IF (ind>nb_domain(rank)) THEN 
     443        rank=rank+1 
     444        ind=1 
     445      ENDIF  
     446      ind_glo=(j-1)*nsplit_i+i 
     447 
     448      nd_glo=nd_glo+1 
     449      IF (nd_glo==ndomain_glo) THEN 
     450 
     451        exit=.TRUE. 
     452        IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN 
     453          PRINT *, "Distribution problem in assign_domain" 
     454          STOP 
     455        ENDIF 
     456 
     457      ENDIF 
     458 
    421459      domglo_rank(ind_glo)=rank 
    422460      domglo_loc_ind(ind_glo)=ind 
    … …  
    426464      ENDIF 
    427465       
    428       IF (ind==nb_domain(rank)) THEN 
    429         rank=rank+1 
    430         ind=0 
    431       ENDIF 
     466      j=j+1 
     467      ind=ind+1 
     468       
    432469    ENDDO 
     470 
     471    IF (is_mpi_master) THEN 
     472    
     473      ind_glo=0 
     474      WRITE(*,'') 
     475      PRINT*, '      MPI PROCESS DISTRIBUTION' 
     476      WRITE(*,'') 
     477       
     478      WRITE(*,"(' ')", ADVANCE='NO') 
     479      DO n=1,nsplit_i*7-1 
     480        WRITE(*,"('=')", ADVANCE='NO') 
     481      ENDDO 
     482      WRITE(*,'') 
     483 
     484      DO nf=1,nb_face 
     485        DO j=1,nsplit_j 
     486          IF (j>1) THEN 
     487            WRITE(*,"(' ')", ADVANCE='NO') 
     488            DO n=1,nsplit_i*7-1 
     489              WRITE(*,"('-')", ADVANCE='NO') 
     490            ENDDO 
     491            WRITE(*,'') 
     492          ENDIF 
     493 
     494          WRITE(*,"('|')", ADVANCE='NO') 
     495          DO i=1,nsplit_i 
     496            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')          
     497          ENDDO 
     498          WRITE(*,'') 
     499 
     500          WRITE(*,"('|')", ADVANCE='NO') 
     501          DO i=1,nsplit_i 
     502            ind_glo=ind_glo+1 
     503            WRITE(*,"(' ',i4.4  ,' |')",ADVANCE='NO'),domglo_rank(ind_glo)            
     504          END DO 
     505          WRITE(*,'') 
     506 
     507          WRITE(*,"('|')", ADVANCE='NO') 
     508          DO i=1,nsplit_i 
     509            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')          
     510          ENDDO 
     511          WRITE(*,'') 
     512 
     513        ENDDO 
     514           
     515        WRITE(*,"(' ')", ADVANCE='NO') 
     516        DO n=1,nsplit_i*7-1 
     517          WRITE(*,"('=')", ADVANCE='NO') 
     518        ENDDO 
     519        WRITE(*,'') 
     520      ENDDO 
     521    ENDIF 
     522               
     523!    rank=0 
     524!    ind=0 
     525!    DO ind_glo=1,ndomain_glo 
     526!      ind=ind+1 
     527!      domglo_rank(ind_glo)=rank 
     528!      domglo_loc_ind(ind_glo)=ind 
     529!      IF (rank==mpi_rank) THEN  
     530!        CALL copy_domain(domain_glo(ind_glo),domain(ind)) 
     531!        domloc_glo_ind(ind)=ind_glo 
     532!      ENDIF 
     533!       
     534!      IF (ind==nb_domain(rank)) THEN 
     535!        rank=rank+1 
     536!        ind=0 
     537!      ENDIF 
     538!    ENDDO 
    433539 
    434540!$OMP PARALLEL 

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

    r325 r327  
    1818    USE etat0_dcmip5_mod, ONLY : getin_etat0_dcmip5=>getin_etat0 
    1919    USE etat0_williamson_mod, ONLY : getin_etat0_williamson=>getin_etat0 
     20    USE etat0_temperature_mod, ONLY: getin_etat0_temperature=>getin_etat0 
    2021    ! Old interface 
    2122    USE etat0_academic_mod, ONLY : etat0_academic=>etat0   
    … …  
    5556    CASE ('isothermal') 
    5657       CALL getin_etat0_isothermal 
     58       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q) 
     59    CASE ('temperature_profile') 
     60       CALL getin_etat0_temperature 
    5761       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q) 
    5862    CASE ('jablonowsky06') 
    … …  
    161165    USE etat0_dcmip5_mod, ONLY : compute_dcmip5 => compute_etat0 
    162166    USE etat0_williamson_mod, ONLY : compute_w91_6 => compute_etat0 
     167    USE etat0_temperature_mod, ONLY: compute_etat0_temperature => compute_etat0 
    163168    IMPLICIT NONE 
    164169    REAL(rstd),INTENT(INOUT) :: ps(iim*jjm) 
    … …  
    186191       CALL compute_etat0_isothermal(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q) 
    187192       CALL compute_etat0_isothermal(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e) 
     193    CASE ('temperature_profile') 
     194       CALL compute_etat0_temperature(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q) 
     195       CALL compute_etat0_temperature(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e) 
    188196    CASE('jablonowsky06') 
    189197       CALL compute_jablonowsky06(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i) 

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

    r295 r327  
    1212  USE xios_mod 
    1313  USE write_field 
     14  USE physics_mod 
     15 
    1416!  USE getin_mod 
    1517  IMPLICIT NONE 
    … …  
    4244  CALL output_field_init 
    4345  CALL init_timeloop 
    44    
     46!$OMP END PARALLEL 
     47  
     48  CALL init_physics 
     49    
     50!$OMP PARALLEL   
    4551  CALL timeloop 
    4652  CALL switch_omp_no_distrib_level 

  • codes/icosagcm/trunk/src/omp_para.F90

    r324 r327  
    6868  IMPLICIT NONE 
    6969  LOGICAL, INTENT(IN) :: is_mpi_master 
    70   INTEGER :: ll_nb,i 
     70  INTEGER :: ll_nb,i,llb,lle 
    7171 
    7272#ifdef CPP_USING_OMP 
    … …  
    7777 
    7878  IF (using_openmp) THEN     
    79 !$OMP PARALLEL PRIVATE(ll_nb,i) 
     79!$OMP PARALLEL PRIVATE(ll_nb,i,llb,lle) 
    8080   
    8181!$OMP MASTER 
    … …  
    123123    IF (omp_level_rank==omp_level_size-1) is_omp_last_level=.TRUE. 
    124124     
    125     ll_end=0 
     125    lle=0 
     126     
    126127    DO i=0,omp_level_rank 
    127       ll_begin=ll_end+1 
     128      llb=lle+1 
    128129      ll_nb=llm/omp_level_size 
    129130      IF (MOD(llm,omp_level_size)>i) ll_nb=ll_nb+1 
    130       ll_end=ll_begin+ll_nb-1 
     131      lle=llb+ll_nb-1 
    131132    ENDDO 
     133    ll_begin=llb 
     134    ll_end=lle 
    132135     
    133136    ll_beginp1=ll_begin 
    … …  
    160163 
    161164   ELSE 
    162      is_master=is_mpi_master 
    163165     omp_size=1 
    164166     omp_level_size=1 
    … …  
    198200  END SUBROUTINE init_omp_para 
    199201 
     202  SUBROUTINE distrib_level(size,lbegin,lend) 
     203  IMPLICIT NONE 
     204    INTEGER,INTENT(IN)  :: size   
     205    INTEGER,INTENT(OUT) :: lbegin   
     206    INTEGER,INTENT(OUT) :: lend   
     207    INTEGER :: div,rest 
     208     
     209    div=size/omp_level_size 
     210    rest=MOD(size,omp_level_size) 
     211    IF (omp_level_rank<rest) THEN 
     212      lbegin=(div+1)*omp_level_rank+1 
     213      lend=lbegin+div 
     214    ELSE 
     215      lbegin=(div+1)*rest + (omp_level_rank-rest)*div+1 
     216      lend=lbegin+div-1 
     217    ENDIF 
     218  END SUBROUTINE distrib_level 
     219 
    200220 
    201221  SUBROUTINE switch_omp_distrib_level 

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

    r325 r327  
    55  PRIVATE 
    66 
    7   INTEGER, PARAMETER :: phys_none=0, phys_HS94=1, phys_DCMIP=2, phys_LB2012=3 
     7  INTEGER, PARAMETER :: phys_none=0, phys_HS94=1, phys_DCMIP=2, phys_lmdz_generic=3, phys_LB2012=4  
    88 
    99  INTEGER :: phys_type 
    … …  
    2626    USE physics_dcmip_mod, ONLY : init_physics_dcmip=>init_physics 
    2727    USE etat0_venus_mod, ONLY : init_phys_venus=>init_physics 
     28    USE physics_lmdz_generic_mod, ONLY : init_physics_lmdz_generic=>init_physics 
    2829    IMPLICIT NONE 
    2930 
    … …  
    4041       phys_type = phys_LB2012 
    4142       CALL init_phys_venus 
     43 
     44    CASE ('phys_lmdz_generic') 
     45       CALL init_physics_lmdz_generic 
     46       phys_type=phys_lmdz_generic 
    4247    CASE ('dcmip') 
    4348       CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon') 
    … …  
    5055    CASE DEFAULT 
    5156       IF(is_mpi_root) PRINT*, 'init_physics : Bad selector for variable physics <',& 
    52             TRIM(physics_type), '> options are <none>, <held_suarez>, <Lebonnois2012>, <dcmip>' 
     57            TRIM(physics_type), '> options are <none>, <held_suarez>, <Lebonnois2012>, <dcmip>, <phys_lmdz_generic>' 
    5358       STOP 
    5459    END SELECT 
    … …  
    5762  END SUBROUTINE init_physics 
    5863 
    59   SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
    60     USE icosa 
    61     USE physics_interface_mod 
     64  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q) 
     65    USE icosa 
     66    USE physics_interface_mod 
     67    USE physics_lmdz_generic_mod, ONLY : physics_lmdz_generic => physics 
    6268    USE physics_dcmip_mod, ONLY : write_physics_dcmip => write_physics 
    6369    USE etat0_heldsz_mod 
    … …  
    6975    TYPE(t_field),POINTER :: f_theta_rhodz(:) 
    7076    TYPE(t_field),POINTER :: f_ue(:) 
     77    TYPE(t_field),POINTER :: f_wflux(:) 
    7178    TYPE(t_field),POINTER :: f_q(:) 
    7279    REAL(rstd),POINTER :: phis(:) 
    … …  
    8794       CASE(phys_HS94) 
    8895          CALL held_suarez(f_ps,f_theta_rhodz,f_ue)  
     96       CASE (phys_lmdz_generic) 
     97         CALL physics_lmdz_generic(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q) 
    8998       CASE(phys_LB2012) 
    9099          CALL phys_venus(f_ps,f_theta_rhodz,f_ue)  

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

    r266 r327  
    2121  USE spherical_geom_mod 
    2222  USE transfert_mod 
     23  USE disvert_mod 
    2324  
    2425  IMPLICIT NONE  
    … …  
    3839  CHARACTER(LEN=255) :: restart_file_name 
    3940  INTEGER,PARAMETER  :: nvert=6 
    40   INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId, nqId 
     41  INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId, nqId, levAxisId 
    4142  INTEGER    :: ind,ind_glo,i,j,k,nf 
    4243  INTEGER    :: status 
    … …  
    9192      status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ vertId,cellId /),bounds_lonId) 
    9293      status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ vertId,cellId /),bounds_latId) 
     94      status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ levId /),levAxisId) 
     95      status = NF90_PUT_ATT(ncid,levAxisId,"axis","Z") 
     96      status = NF90_PUT_ATT(ncid,levAxisId,"units","Pa") 
     97      status = NF90_PUT_ATT(ncid,levAxisId,"positive","down") 
    9398       
    9499      DO nf=1,nfield 
    … …  
    97102          IF (field(1)%ndim==2) THEN 
    98103            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId /),fieldId(nf)) 
     104            status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat") 
    99105          ELSE IF (field(1)%ndim==3) THEN 
    100106            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId /),fieldId(nf)) 
     107            status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lev lon lat") 
    101108          ELSE IF (field(1)%ndim==4) THEN 
    102109            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId,nqId /),fieldId(nf)) 
     110            status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","nq lev lon lat") 
    103111          ENDIF 
    104           status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat") 
    105112        ELSE IF (field(1)%field_type==field_U) THEN 
    106113          IF (field(1)%ndim==2) THEN 
    … …  
    139146      status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /)) 
    140147      status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /)) 
     148      status=NF90_PUT_VAR(ncid,levAxisId,REAL(presnivs,r8),start=(/ 1 /),count=(/ llm /)) 
    141149    ENDIF 
    142150 

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

    r295 r327  
    9292    itau_physics=1 
    9393    CALL getin('itau_physics',itau_physics) 
     94    if (itau_physics<=0) itau_physics = HUGE(itau_physics) 
    9495 
    9596    itau_check_conserv=HUGE(itau_check_conserv) 

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

    r326 r327  
    4040  USE write_field 
    4141  USE theta2theta_rhodz_mod 
     42  USE sponge_mod 
    4243  IMPLICIT NONE 
    4344 
    … …  
    111112           f_psm2 => f_phis 
    112113        END IF 
     114      CASE ('none') 
     115        nb_stage=0 
    113116 
    114117    CASE default 
    … …  
    120123    CALL init_theta2theta_rhodz 
    121124    CALL init_dissip 
     125    CALL init_sponge 
    122126    CALL init_caldyn 
    123127    CALL init_guided 
    124128    CALL init_advect_tracer 
    125129    CALL init_check_conserve 
    126     CALL init_physics 
    127      
    128130 
    129131    CALL etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q) 
    … …  
    144146  USE icosa 
    145147  USE dissip_gcm_mod 
     148  USE sponge_mod 
    146149  USE disvert_mod 
    147150  USE caldyn_mod 
    … …  
    176179    INTEGER :: rate_clock 
    177180    INTEGER :: l 
     181    LOGICAL,SAVE :: first_physic=.TRUE. 
     182!$OMP THREADPRIVATE(first_physic)     
    178183     
    179      
    180 !    CALL write_etat0(f_ps, f_phis,f_theta_rhodz,f_u,f_q)  
    181 !    CALL read_start(f_ps,f_mass,f_phis,f_theta_rhodz,f_u,f_q)  
    182 !    CALL write_restart(f_ps,f_mass,f_phis,f_theta_rhodz,f_u,f_q)  
    183      
     184    
    184185    CALL switch_omp_distrib_level 
    185186    CALL caldyn_BC(f_phis, f_wflux) ! set constant values in first/last interfaces 
    … …  
    228229      CALL wait_message(req_q0)  
    229230 
    230 !      CALL wait_message(req_ps0) 
    231 !      CALL wait_message(req_mass0) 
    232 !      CALL wait_message(req_theta_rhodz0)  
    233 !      CALL wait_message(req_u0) 
    234 !      CALL wait_message(req_q0)  
    235231    ENDIF 
    236232 
    … …  
    264260 
    265261    IF (MOD(it,itau_dissip)==0) THEN 
    266 !         CALL send_message(f_ps,req_ps) 
    267 !         CALL wait_message(req_ps)   
    268262        
    269263       IF(caldyn_eta==eta_mass) THEN 
    … …  
    278272          END DO 
    279273       ENDIF 
    280 !       CALL send_message(f_mass,req_mass) 
    281 !       CALL wait_message(req_mass)   
     274 
    282275       CALL dissip(f_u,f_du,f_mass,f_phis, f_theta_rhodz,f_dtheta_rhodz) 
    283276 
    284 !       CALL send_message(f_mass,req_mass) 
    285 !       CALL wait_message(req_mass)   
    286277       CALL euler_scheme(.FALSE.)  ! update only u, theta 
     278       IF (iflag_sponge > 0) THEN 
     279         CALL sponge(f_u,f_du,f_theta_rhodz,f_dtheta_rhodz) 
     280         CALL euler_scheme(.FALSE.)  ! update only u, theta 
     281       ENDIF 
    287282    END IF 
    288283 
    … …  
    308303    END IF 
    309304 
    310     CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u,  f_q) 
    311305 
    312306    IF (MOD(it,itau_check_conserv)==0) THEN 
    313       CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)   
     307      CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)  
     308    ENDIF 
     309      
     310    IF (MOD(it,itau_physics)==0) THEN 
     311      CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q) 
     312 
     313!$OMP MASTER 
     314   IF (first_physic) CALL SYSTEM_CLOCK(start_clock) 
     315!$OMP END MASTER    
     316      first_physic=.FALSE. 
    314317    ENDIF 
    315318     
    … …  
    354357          ELSE ! update mass 
    355358             mass=f_mass(ind) ; dmass=f_dmass(ind) ;               
    356              DO l=1,llm 
     359             DO l=ll_begin,ll_end 
    357360!$SIMD 
    358361                DO ij=ij_begin,ij_end 
    … …  
    606609  END SUBROUTINE accumulate_fluxes 
    607610   
    608 !  FUNCTION maxval_i(p) 
    609 !    USE icosa 
    610 !    IMPLICIT NONE 
    611 !    REAL(rstd), DIMENSION(iim*jjm) :: p 
    612 !    REAL(rstd) :: maxval_i 
    613 !    INTEGER :: j, ij 
    614 !     
    615 !    maxval_i=p((jj_begin-1)*iim+ii_begin) 
    616 !     
    617 !    DO j=jj_begin-1,jj_end+1 
    618 !       ij=(j-1)*iim 
    619 !       maxval_i = MAX(maxval_i, MAXVAL(p(ij+ii_begin:ij+ii_end))) 
    620 !    END DO 
    621 !  END FUNCTION maxval_i 
    622  
    623 !  FUNCTION maxval_ik(p) 
    624 !    USE icosa 
    625 !    IMPLICIT NONE 
    626 !    REAL(rstd) :: p(iim*jjm, llm) 
    627 !    REAL(rstd) :: maxval_ik(llm) 
    628 !    INTEGER :: l,j, ij 
    629 !     
    630 !    DO l=1,llm 
    631 !       maxval_ik(l)=p((jj_begin-1)*iim+ii_begin,l) 
    632 !       DO j=jj_begin-1,jj_end+1 
    633 !          ij=(j-1)*iim 
    634 !          maxval_ik(l) = MAX(maxval_ik(l), MAXVAL(p(ij+ii_begin:ij+ii_end,l))) 
    635 !       END DO 
    636 !    END DO 
    637 !  END FUNCTION maxval_ik 
    638  
    639611END MODULE timeloop_gcm_mod 

  • codes/icosagcm/trunk/src/trace.F90

    r186 r327  
    4343      
    4444  END SUBROUTINE trace_off 
     45 
    4546     
    4647  SUBROUTINE trace_start(name) 
    … …  
    5960  END SUBROUTINE trace_start     
    6061 
     62 
    6163  SUBROUTINE trace_end(name) 
    6264  IMPLICIT NONE 
    … …  
    7476 
    7577  END SUBROUTINE trace_end     
     78 
     79 
    7680 
    7781  SUBROUTINE trace_start2(name) 

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

    r295 r327  
    159159      DO j=jj_begin,jj_end 
    160160        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left) 
     161      ENDDO     
     162      DO j=jj_begin,jj_end 
    161163        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup) 
    162164      ENDDO     
    … …  
    169171      DO j=jj_begin,jj_end 
    170172        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right) 
     173      ENDDO    
     174      DO j=jj_begin,jj_end 
    171175        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown) 
    172176      ENDDO    
    … …  
    213217      DO j=jj_begin,jj_end 
    214218        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left) 
     219      ENDDO     
     220      DO j=jj_begin,jj_end 
    215221        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup) 
    216222      ENDDO     
    … …  
    223229      DO j=jj_begin,jj_end 
    224230        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right) 
     231      ENDDO    
     232      DO j=jj_begin,jj_end 
    225233        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown) 
    226234      ENDDO    
    … …  
    10961104    INTEGER,POINTER :: sign(:) 
    10971105    INTEGER :: offset,msize,rank 
    1098  
    1099     CALL trace_start("transfert_mpi") 
     1106    INTEGER :: lbegin, lend 
     1107 
     1108!    CALL trace_start("send_message_mpi") 
    11001109 
    11011110!$OMP BARRIER 
    … …  
    11921201       
    11931202        DO ind=1,ndomain 
    1194           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1203          IF (.NOT. assigned_domain(ind) ) CYCLE 
    11951204 
    11961205          dim3=size(field(ind)%rval3d,2) 
     1206          CALL distrib_level(dim3,lbegin,lend) 
     1207 
    11971208          rval3d=>field(ind)%rval3d 
    11981209          req=>message%request(ind) 
    … …  
    12051216              ireq=send%ireq 
    12061217              buffer_r=>message%buffers(ireq)%r 
    1207               offset=send%offset*dim3 
    1208  
    1209               DO d3=1,dim3 
     1218 
     1219              offset=send%offset*dim3 + (lbegin-1)*send%size 
     1220           
     1221              CALL trace_start("copy_to_buffer") 
     1222 
     1223              DO d3=lbegin,lend 
    12101224                DO n=1,send%size 
    12111225                  buffer_r(n+offset)=rval3d(value(n),d3) 
    … …  
    12131227                offset=offset+send%size 
    12141228              ENDDO 
    1215  
    1216               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1217                 !$OMP CRITICAL    
    1218                 CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
    1219                 !$OMP END CRITICAL 
    1220               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1221                 CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1229              CALL trace_end("copy_to_buffer") 
     1230 
     1231              IF (is_omp_level_master) THEN 
     1232                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1233                  !$OMP CRITICAL    
     1234                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1235                  !$OMP END CRITICAL 
     1236                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1237                  CALL MPI_ISEND(buffer_r,send%size*dim3,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1238                ENDIF 
    12221239              ENDIF 
    12231240            ENDIF 
    … …  
    12261243          
    12271244        DO ind=1,ndomain 
    1228           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1245          IF (.NOT. assigned_domain(ind) ) CYCLE 
    12291246          dim3=size(field(ind)%rval3d,2) 
     1247          CALL distrib_level(dim3,lbegin,lend) 
    12301248          rval3d=>field(ind)%rval3d 
    12311249          req=>message%request(ind) 
    … …  
    12401258              sgn=>recv%sign 
    12411259 
    1242               DO n=1,recv%size 
    1243                 rval3d(value(n),:)=src_rval3d(src_value(n),:)*sgn(n) 
     1260              CALL trace_start("copy_data") 
     1261 
     1262              DO d3=lbegin,lend 
     1263                DO n=1,recv%size 
     1264                  rval3d(value(n),d3)=src_rval3d(src_value(n),d3)*sgn(n) 
     1265                ENDDO 
    12441266              ENDDO 
     1267              CALL trace_end("copy_data") 
    12451268 
    12461269            ELSE 
    … …  
    12481271              buffer_r=>message%buffers(ireq)%r 
    12491272  
    1250               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1251                 !$OMP CRITICAL 
    1252                 CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
    1253                 !$OMP END CRITICAL 
    1254               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1255                 CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1273              IF (is_omp_level_master) THEN 
     1274                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1275                  !$OMP CRITICAL 
     1276                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1277                  !$OMP END CRITICAL 
     1278                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1279                  CALL MPI_IRECV(buffer_r,recv%size*dim3,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1280                ENDIF 
    12561281              ENDIF 
    1257             ENDIF 
     1282            ENDIF   
    12581283          ENDDO 
    12591284         
    … …  
    12631288     
    12641289        DO ind=1,ndomain 
    1265           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master ) CYCLE 
     1290          IF (.NOT. assigned_domain(ind) ) CYCLE 
    12661291 
    12671292          dim3=size(field(ind)%rval4d,2) 
     1293          CALL distrib_level(dim3,lbegin,lend) 
    12681294          dim4=size(field(ind)%rval4d,3) 
    12691295          rval4d=>field(ind)%rval4d 
    … …  
    12781304              ireq=send%ireq 
    12791305              buffer_r=>message%buffers(ireq)%r 
    1280               offset=send%offset*dim3*dim4 
    1281  
     1306 
     1307              CALL trace_start("copy_to_buffer") 
    12821308              DO d4=1,dim4 
    1283                 DO d3=1,dim3 
     1309                offset=send%offset*dim3*dim4 + dim3*send%size*(d4-1) + (lbegin-1)*send%size 
     1310 
     1311                DO d3=lbegin,lend 
    12841312                  DO n=1,send%size 
    12851313                    buffer_r(n+offset)=rval4d(value(n),d3,d4) 
    … …  
    12881316                ENDDO 
    12891317              ENDDO 
    1290  
    1291               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1292                 !$OMP CRITICAL 
    1293                 CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
    1294                 !$OMP END CRITICAL 
    1295               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1296                 CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1318              CALL trace_end("copy_to_buffer") 
     1319 
     1320              IF (is_omp_level_master) THEN 
     1321                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1322                  !$OMP CRITICAL 
     1323                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1324                  !$OMP END CRITICAL 
     1325                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1326                  CALL MPI_ISEND(buffer_r,send%size*dim3*dim4,MPI_REAL8,send%rank,send%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr) 
     1327                ENDIF 
    12971328              ENDIF 
    12981329 
    … …  
    13021333         
    13031334        DO ind=1,ndomain 
    1304           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1335          IF (.NOT. assigned_domain(ind) ) CYCLE 
    13051336           
    13061337          dim3=size(field(ind)%rval4d,2) 
     1338          CALL distrib_level(dim3,lbegin,lend) 
    13071339          dim4=size(field(ind)%rval4d,3) 
    13081340          rval4d=>field(ind)%rval4d 
    … …  
    13171349              sgn=>recv%sign 
    13181350 
    1319               DO n=1,recv%size 
    1320                 rval4d(value(n),:,:)=src_rval4d(src_value(n),:,:)*sgn(n) 
     1351              CALL trace_start("copy_data") 
     1352              DO d4=1,dim4 
     1353                DO d3=lbegin,lend 
     1354                  DO n=1,recv%size 
     1355                    rval4d(value(n),d3,d4)=src_rval4d(src_value(n),d3,d4)*sgn(n) 
     1356                  ENDDO 
     1357                ENDDO 
    13211358              ENDDO 
     1359                 
     1360              CALL trace_end("copy_data") 
    13221361                    
    13231362            ELSE 
    … …  
    13251364              ireq=recv%ireq 
    13261365              buffer_r=>message%buffers(ireq)%r 
    1327               IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
    1328                 !$OMP CRITICAL            
    1329                 CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
    1330                 !$OMP END CRITICAL 
    1331               ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
    1332                 CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
     1366              IF (is_omp_level_master) THEN 
     1367                IF (mpi_threading_mode==MPI_THREAD_SERIALIZED) THEN 
     1368                 !$OMP CRITICAL            
     1369                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
     1370                  !$OMP END CRITICAL 
     1371                ELSE IF (mpi_threading_mode==MPI_THREAD_MULTIPLE) THEN 
     1372                  CALL MPI_IRECV(buffer_r,recv%size*dim3*dim4,MPI_REAL8,recv%rank,recv%tag+1000*message%number,comm_icosa, message%mpi_req(ireq),ierr)  
     1373                ENDIF 
    13331374              ENDIF 
    1334      
    13351375            ENDIF 
    13361376          ENDDO 
    … …  
    13621402     
    13631403!$OMP BARRIER 
    1364     CALL trace_end("transfert_mpi") 
     1404!    CALL trace_end("send_message_mpi") 
    13651405     
    13661406  END SUBROUTINE send_message_mpi 
    … …  
    14021442    INTEGER :: ireq,nreq 
    14031443    INTEGER :: ind,n,l,m,i 
    1404     INTEGER :: dim3,dim4,d3,d4 
     1444    INTEGER :: dim3,dim4,d3,d4,lbegin,lend 
    14051445    INTEGER :: offset 
    14061446 
    14071447    IF (.NOT. message%pending) RETURN 
    14081448 
    1409     CALL trace_start("transfert_mpi") 
     1449!    CALL trace_start("wait_message_mpi") 
    14101450 
    14111451    field=>message%field 
    … …  
    14521492         
    14531493        DO ind=1,ndomain 
    1454           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1494          IF (.NOT. assigned_domain(ind) ) CYCLE 
    14551495 
    14561496          rval3d=>field(ind)%rval3d 
    … …  
    14651505               
    14661506              dim3=size(rval3d,2) 
    1467               offset=recv%offset*dim3 
    1468               DO d3=1,dim3 
    1469                 DO n=1,recv%size 
    1470                   rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)   
     1507     
     1508              CALL distrib_level(dim3,lbegin,lend) 
     1509              offset=recv%offset*dim3 + (lbegin-1)*recv%size 
     1510              CALL trace_start("copy_from_buffer") 
     1511               
     1512              IF (req%vector) THEN 
     1513                DO d3=lbegin,lend 
     1514                  DO n=1,recv%size 
     1515                    rval3d(value(n),d3)=buffer_r(n+offset)*sgn(n)   
     1516                  ENDDO 
     1517                  offset=offset+recv%size 
    14711518                ENDDO 
    1472                 offset=offset+recv%size 
    1473               ENDDO   
     1519              ELSE 
     1520                DO d3=lbegin,lend 
     1521                  DO n=1,recv%size 
     1522                    rval3d(value(n),d3)=buffer_r(n+offset)   
     1523                  ENDDO 
     1524                  offset=offset+recv%size 
     1525                ENDDO 
     1526              ENDIF 
     1527                 
     1528              CALL trace_end("copy_from_buffer") 
    14741529            ENDIF 
    14751530          ENDDO 
    … …  
    14851540                 
    14861541        DO ind=1,ndomain 
    1487           IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
     1542          IF (.NOT. assigned_domain(ind) ) CYCLE 
    14881543 
    14891544          rval4d=>field(ind)%rval4d 
    … …  
    14981553 
    14991554              dim3=size(rval4d,2) 
     1555              CALL distrib_level(dim3,lbegin,lend) 
    15001556              dim4=size(rval4d,3) 
    1501               offset=recv%offset*dim3*dim4 
     1557              CALL trace_start("copy_from_buffer") 
    15021558              DO d4=1,dim4 
    1503                 DO d3=1,dim3 
     1559                offset=recv%offset*dim3*dim4 + dim3*recv%size*(d4-1) + (lbegin-1)*recv%size 
     1560                DO d3=lbegin,lend 
    15041561                  DO n=1,recv%size 
    15051562                    rval4d(value(n),d3,d4)=buffer_r(n+offset)*sgn(n)  
    … …  
    15081565                ENDDO 
    15091566              ENDDO 
     1567              CALL trace_end("copy_from_buffer") 
    15101568            ENDIF 
    15111569          ENDDO 
    … …  
    15211579!$OMP END MASTER 
    15221580 
    1523     CALL trace_end("transfert_mpi") 
     1581!    CALL trace_end("wait_message_mpi") 
    15241582!$OMP BARRIER 
    15251583     
    … …  
    17281786         
    17291787  END SUBROUTINE scatter_field 
    1730  
    1731  
    1732     
     1788   
    17331789  SUBROUTINE trace_in 
    17341790  USE trace 
    … …  
    17521808!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    17531809 
    1754 !! -- Les chaine de charactère -- !! 
     1810!! -- Les chaine de charactï¿œre -- !! 
    17551811 
    17561812  SUBROUTINE bcast_mpi_c(var1) 
    … …  
    19492005    IF (.NOT. using_mpi) RETURN 
    19502006 
    1951     CALL MPI_BCAST(Var,nb,MPI_REAL,mpi_master,comm_icosa,ierr) 
     2007    CALL MPI_BCAST(Var,nb,MPI_REAL8,mpi_master,comm_icosa,ierr) 
    19522008     
    19532009  END SUBROUTINE bcast_mpi_rgen 

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

    r295 r327  
    102102!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    103103 
    104 !! -- Les chaine de charactère -- !! 
     104!! -- Les chaine de charactï¿œre -- !! 
    105105 
    106106  SUBROUTINE bcast_omp_c(var) 
Note: See TracChangeset for help on using the changeset viewer.