Changeset 726 for codes/icosagcm


Ignore:
Timestamp:
08/22/18 17:28:01 (6 years ago)
Author:
dubos
Message:

devel : backported from trunk commits r707-r711,r713

Location:
codes/icosagcm/devel/src
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/devel/src/icosa_init.f90

    r714 r726  
    5555    CALL output_field_init 
    5656    CALL init_timeloop 
     57 
     58  !$OMP END PARALLEL 
     59 
    5760    CALL init_physics 
    5861 
     62  !$OMP PARALLEL 
     63   
    5964    CALL init_diagflux 
    6065    CALL zero_du_phys 

  • codes/icosagcm/devel/src/initial/etat0_database.f90

    r531 r726  
    5757    CALL writeField("relief_out",f_phis,once=.TRUE.) 
    5858 
    59     DO ind=1,ndomain 
    60       IF (.NOT. assigned_domain(ind)) CYCLE 
    61       f_phis(ind)%rval2d(:)=f_phis(ind)%rval2d(:)*g       
    62     ENDDO 
    63  
     59    IF (is_omp_level_master) THEN 
     60      DO ind=1,ndomain 
     61        IF (.NOT. assigned_domain(ind)) CYCLE 
     62        f_phis(ind)%rval2d(:)=f_phis(ind)%rval2d(:)*g       
     63      ENDDO 
     64    ENDIF 
     65!$OMP BARRIER     
    6466 
    6567    IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn",n_glo=nb_level) 
    … …  
    98100! make correction to ps due to relief at higher resolution 
    99101! difference with LMDZ : tsol is taken from ECDYN.NC and not from ECPHY 
    100     DO ind=1,ndomain 
    101       IF (.NOT. assigned_domain(ind)) CYCLE 
    102       f_ps(ind)%rval2d(:)=f_ps(ind)%rval2d(:)*(1.+(f_z(ind)%rval2d(:)-f_phis(ind)%rval2d(:))/287.0/f_ts(ind)%rval2d(:)) 
    103     ENDDO 
     102    IF (is_omp_level_master) THEN 
     103      DO ind=1,ndomain 
     104        IF (.NOT. assigned_domain(ind)) CYCLE 
     105        f_ps(ind)%rval2d(:)=f_ps(ind)%rval2d(:)*(1.+(f_z(ind)%rval2d(:)-f_phis(ind)%rval2d(:))/287.0/f_ts(ind)%rval2d(:)) 
     106      ENDDO 
     107    ENDIF 
     108!$OMP BARRIER     
    104109    CALL transfert_request(f_ps,req_i0)  
    105110    CALL writeField("ps_out",f_ps) 
    … …  
    135140    ENDDO 
    136141 
     142    CALL writeField("tempdb_out",f_temp_reg) 
     143    CALL writeField("temp_out",f_temp) 
    137144 
    138145    CALL deallocate_field(f_ts) 

  • codes/icosagcm/devel/src/output/xios_mod.F90

    r551 r726  
    463463 SUBROUTINE xios_read_var(name,field) 
    464464   USE prec 
     465   USE transfert_mod 
    465466   CHARACTER(LEN=*),INTENT(IN) :: name 
    466467   REAL(rstd), INTENT(OUT) :: field 
     468   !$OMP MASTER 
    467469   CALL xios_recv_field(name,field) 
     470   !$OMP END MASTER 
     471   CALL bcast_omp(field) 
    468472 END SUBROUTINE 
    469473 

  • codes/icosagcm/devel/src/parallel/domain.f90

    r533 r726  
    2525    INTEGER,POINTER  :: edge_assign_pos(:,:,:) 
    2626    INTEGER,POINTER  :: edge_assign_sign(:,:,:) 
     27    INTEGER,POINTER  :: vertex_assign_domain(:,:,:) 
     28    INTEGER,POINTER  :: vertex_assign_i(:,:,:) 
     29    INTEGER,POINTER  :: vertex_assign_j(:,:,:) 
     30    INTEGER,POINTER  :: vertex_assign_pos(:,:,:) 
    2731    REAL,POINTER     :: xyz(:,:,:) 
    2832    REAL,POINTER     :: neighbour(:,:,:,:) 
    … …  
    151155          ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm)) 
    152156          ALLOCATE(d%edge_assign_sign(0:5,d%iim,d%jjm)) 
     157          ALLOCATE(d%vertex_assign_domain(0:5,d%iim,d%jjm)) 
     158          ALLOCATE(d%vertex_assign_i(0:5,d%iim,d%jjm)) 
     159          ALLOCATE(d%vertex_assign_j(0:5,d%iim,d%jjm)) 
     160          ALLOCATE(d%vertex_assign_pos(0:5,d%iim,d%jjm)) 
    153161          ALLOCATE(d%delta(d%iim,d%jjm)) 
    154162          ALLOCATE(d%xyz(3,d%iim,d%jjm)) 
    … …  
    193201    d2%edge_assign_pos => d1%edge_assign_pos 
    194202    d2%edge_assign_sign => d1%edge_assign_sign 
     203    d2%vertex_assign_domain => d1%vertex_assign_domain 
     204    d2%vertex_assign_i => d1%vertex_assign_i 
     205    d2%vertex_assign_j => d1%vertex_assign_j 
     206    d2%vertex_assign_pos => d1%vertex_assign_pos 
    195207    d2%xyz => d1%xyz 
    196208    d2%neighbour => d1%neighbour 
    … …  
    231243  USE metric 
    232244  IMPLICIT NONE 
    233     INTEGER :: ind_d,ind,ind2,e 
     245    INTEGER :: ind_d,ind,ind2,e,v 
    234246    INTEGER :: nf,nf2 
    235247    INTEGER :: i,j,k,ii,jj 
    … …  
    258270          IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4) 
    259271          IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5) 
     272 
     273          IF ( i+1 <= d%ii_end .AND. j+1 <= d%jj_end)  CALL assign_vertex(ind_d,ind,i,j,delta,0) 
     274          IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end)  CALL assign_vertex(ind_d,ind,i,j,delta,1) 
     275          IF ( i-1 >= d%ii_begin .AND.  j+1 <= d%jj_end)  CALL assign_vertex(ind_d,ind,i,j,delta,2) 
     276          IF ( i-1 >= d%ii_begin .AND.  j-1 >= d%jj_begin)  CALL assign_vertex(ind_d,ind,i,j,delta,3) 
     277          IF ( i+1 <= d%ii_end .AND.  j-1 >= d%jj_begin)  CALL assign_vertex(ind_d,ind,i,j,delta,4) 
     278          IF ( i+1 <= d%ii_end .AND.  j-1 >= d%jj_begin)  CALL assign_vertex(ind_d,ind,i,j,delta,5) 
    260279        ENDDO 
    261280      ENDDO 
    … …  
    294313              d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j) 
    295314            ENDIF 
     315 
     316            v=cell_glo(ind)%vertex(MOD(k+delta+6,6)) 
     317            d%vertex_assign_domain(k,i,j)=vertices_glo(v)%assign_domain 
     318            d%vertex_assign_i(k,i,j)=vertices_glo(v)%assign_i 
     319            d%vertex_assign_j(k,i,j)=vertices_glo(v)%assign_j 
     320            d%vertex_assign_pos(k,i,j)=vertices_glo(v)%assign_pos 
    296321              
    297322          ENDDO 
    … …  
    318343      edge_glo(e)%assign_delta=delta 
    319344 
    320      END  SUBROUTINE assign_edge 
     345    END  SUBROUTINE assign_edge 
     346  
     347    SUBROUTINE assign_vertex(ind_d,ind,i,j,delta,k) 
     348      INTEGER :: ind_d,ind,i,j,delta,k 
     349      INTEGER :: e 
     350       
     351        e=cell_glo(ind)%vertex(MOD(k+delta+6,6)) 
     352        vertices_glo(e)%assign_domain=ind_d 
     353        vertices_glo(e)%assign_i=i 
     354        vertices_glo(e)%assign_j=j 
     355        vertices_glo(e)%assign_pos=k 
     356        vertices_glo(e)%assign_delta=delta 
     357      
     358    END  SUBROUTINE assign_vertex 
     359               
     360  END SUBROUTINE assign_cell 
    321361          
    322   END SUBROUTINE assign_cell 
    323  
    324362  SUBROUTINE compute_boundary 
    325363  USE spherical_geom_mod 

  • codes/icosagcm/devel/src/parallel/mpipara.F90

    r714 r726  
    5757    IF (using_mpi) THEN 
    5858     
    59       required_mode_str='multiple' 
     59      required_mode_str='funneled' 
    6060      CALL getin('mpi_threading_mode',required_mode_str) 
    6161       
    … …  
    8181      IF (required_mode==MPI_THREAD_MULTIPLE)   PRINT*,'MPI_INIT_THREAD : MPI_THREAD_MULTIPLE required' 
    8282 
    83        
    84       CALL MPI_INIT_THREAD(MPI_THREAD_MULTIPLE,mpi_threading_mode,ierr) 
     83      CALL MPI_INIT_THREAD(required_mode,mpi_threading_mode,ierr) 
    8584       
    8685      IF (mpi_threading_mode==MPI_THREAD_SINGLE)     PRINT*,'MPI_INIT_THREAD : MPI_SINGLE_THREAD provided' 

  • codes/icosagcm/devel/src/parallel/transfert.F90

    r533 r726  
    33#ifdef CPP_USING_MPI 
    44  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, & 
    5                                 req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point,             & 
     5                                req_e1_scal, req_z1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point,             & 
    66                                create_request, gather_field, scatter_field,         & 
    77                                t_message, init_message=>init_message_mpi,           & 
    … …  
    1212#else  
    1313  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_seq, req_i1,req_e1_vect, & 
    14                                 req_e1_scal,req_i0, req_e0_vect, req_e0_scal,        & 
     14                                req_e1_scal, req_z1_scal, req_i0, req_e0_vect, req_e0_scal,        & 
    1515                                request_add_point, create_request, gather_field,     & 
    1616                                scatter_field, t_message,                            & 

  • codes/icosagcm/devel/src/parallel/transfert_mpi.f90

    r714 r726  
    4949  TYPE(t_request),SAVE,POINTER :: req_e1_scal(:) 
    5050  TYPE(t_request),SAVE,POINTER :: req_e1_vect(:) 
     51  TYPE(t_request),SAVE,POINTER :: req_z1_scal(:) 
    5152   
    5253  TYPE(t_request),SAVE,POINTER :: req_i0(:) 
    … …  
    267268    CALL finalize_request(req_e0_vect) 
    268269 
     270    CALL create_request(field_z,req_z1_scal) 
     271    DO ind=1,ndomain 
     272      CALL swap_dimensions(ind) 
     273      DO i=ii_begin,ii_end 
     274        CALL request_add_point(ind,i,jj_begin-1,req_z1_scal,vrup) 
     275        CALL request_add_point(ind,i+1,jj_begin-1,req_z1_scal,vup) 
     276      ENDDO 
     277 
     278      DO j=jj_begin,jj_end 
     279        CALL request_add_point(ind,ii_end+1,j,req_z1_scal,vlup) 
     280      ENDDO     
     281      DO j=jj_begin,jj_end 
     282        CALL request_add_point(ind,ii_end+1,j-1,req_z1_scal,vup) 
     283      ENDDO     
     284     
     285      DO i=ii_begin,ii_end 
     286        CALL request_add_point(ind,i,jj_end+1,req_z1_scal,vdown) 
     287        CALL request_add_point(ind,i-1,jj_end+1,req_z1_scal,vrdown) 
     288      ENDDO     
     289 
     290      DO j=jj_begin,jj_end 
     291        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrup) 
     292      ENDDO    
     293      DO j=jj_begin,jj_end 
     294        CALL request_add_point(ind,ii_begin-1,j,req_z1_scal,vrdown) 
     295      ENDDO    
     296 
     297    ENDDO 
     298 
     299    CALL finalize_request(req_z1_scal) 
    269300 
    270301  END SUBROUTINE init_transfert 
    … …  
    420451        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme' 
    421452 
    422         src_domain=domain(ind)%assign_domain(i,j) 
     453        src_domain=domain(ind)%vertex_assign_domain(pos-1,i,j) 
    423454        src_iim=domain_glo(src_domain)%iim 
    424         src_i=domain(ind)%assign_i(i,j) 
    425         src_j=domain(ind)%assign_j(i,j) 
     455        src_i=domain(ind)%vertex_assign_i(pos-1,i,j) 
     456        src_j=domain(ind)%vertex_assign_j(pos-1,i,j) 
    426457        src_n=(src_j-1)*src_iim+src_i 
    427458        src_delta=domain(ind)%delta(i,j) 
    428          
    429         src_pos=MOD(pos-1+src_delta+6,6)+1 
     459        src_pos=domain(ind)%vertex_assign_pos(pos-1,i,j)+1 
     460 
    430461         
    431462        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos) 

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

    r714 r726  
    3939    SELECT CASE(TRIM(physics_type)) 
    4040    CASE ('none') 
     41 
     42!$OMP PARALLEL 
    4143       IF(is_mpi_root) PRINT*,"NO PHYSICAL PACKAGE USED" 
    4244       phys_type = phys_none 
     45!$OMP END PARALLEL 
     46 
    4347    CASE ('held_suarez') 
     48 
     49!$OMP PARALLEL 
    4450       phys_type = phys_HS94 
     51!$OMP END PARALLEL 
     52 
    4553    CASE ('Lebonnois2012') 
     54 
     55!$OMP PARALLEL 
    4656       phys_type = phys_LB2012 
    4757       CALL init_phys_venus 
     58!$OMP END PARALLEL 
    4859 
    4960    CASE ('phys_lmdz_generic') 
     61 
     62!$OMP PARALLEL 
    5063       CALL init_physics_lmdz_generic 
    5164       phys_type=phys_lmdz_generic 
     65!$OMP END PARALLEL 
     66 
    5267    CASE ('phys_external') 
     68 
    5369       CALL init_physics_external 
     70!$OMP PARALLEL 
    5471       phys_type=phys_external 
     72!$OMP END PARALLEL 
     73 
    5574    CASE ('dcmip') 
     75 
     76!$OMP PARALLEL 
    5677       CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon') 
    5778       CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat') 
    … …  
    6586       CALL init_pack_after ! Defines Ai, lon, lat in physics_inout 
    6687       phys_type = phys_DCMIP 
     88!$OMP END PARALLEL 
     89 
    6790    CASE ('dcmip2016') 
     91 
     92!$OMP PARALLEL 
    6893       CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon') 
    6994       CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat') 
    … …  
    77102       CALL init_pack_after ! Defines Ai, lon, lat in physics_inout 
    78103       phys_type = phys_DCMIP2016 
     104!$OMP END PARALLEL 
     105 
    79106    CASE DEFAULT 
    80107       IF(is_mpi_root) PRINT*, 'init_physics : Bad selector for variable physics <',& 
    … …  
    84111    END SELECT 
    85112 
     113!$OMP PARALLEL 
    86114    CALL allocate_field(f_du_phys,field_u,type_real,llm, name='du_phys') 
    87115 
    88116    IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type 
     117!$OMP END PARALLEL 
    89118  END SUBROUTINE init_physics 
    90119 

  • codes/icosagcm/devel/src/sphere/metric.f90

    r533 r726  
    77    INTEGER :: neighbour(0:5) 
    88    INTEGER :: edge(0:5) 
     9    INTEGER :: vertex(0:5) 
    910    INTEGER :: assign_face 
    1011    INTEGER :: assign_i 
    … …  
    3233  END TYPE t_edge_glo 
    3334     
     35  TYPE t_vertices_glo 
     36   INTEGER :: assign_domain 
     37   INTEGER :: assign_i 
     38   INTEGER :: assign_j 
     39   INTEGER :: assign_pos 
     40   INTEGER :: assign_delta 
     41  END TYPE t_vertices_glo     
    3442  
    3543  TYPE(t_vertex_glo),ALLOCATABLE,SAVE :: vertex_glo(:,:,:) 
    3644  TYPE(t_cell_glo),ALLOCATABLE,SAVE :: cell_glo(:) 
    3745  TYPE(t_edge_glo),ALLOCATABLE,SAVE :: edge_glo(:) 
     46  TYPE(t_vertices_glo),ALLOCATABLE,SAVE :: vertices_glo(:) 
    3847  INTEGER :: ncell_glo 
    3948   
    … …  
    93102    ALLOCATE(tab_index(nb_face,nb_face,0:5)) 
    94103    ALLOCATE(edge_glo(ncell_glo*3)) 
     104    ALLOCATE(vertices_glo(ncell_glo*2)) 
    95105     
    96106    DO ind=1,ncell_glo 
    … …  
    824834  END SUBROUTINE  set_cell_edge     
    825835         
     836  SUBROUTINE set_cell_vertex 
     837  IMPLICIT NONE 
     838    INTEGER :: i,j,k,k2 
     839    INTEGER :: ind,ind1,ind2 
     840    INTEGER :: ng1,ng2 
     841    INTEGER :: ne      
     842   
     843    DO ind=1,ncell_glo 
     844      cell_glo(ind)%vertex(:)=0 
     845    ENDDO 
     846     
     847    ne=0 
     848    DO ind=1,ncell_glo 
     849      DO k=0,5 
     850        IF (cell_glo(ind)%vertex(k)==0) THEN 
     851          ind1=cell_glo(ind)%neighbour(k) 
     852          DO ng1=0,5 
     853            ind2=cell_glo(ind1)%neighbour(ng1) 
     854            DO ng2=0,5 
     855              IF (cell_glo(ind2)%neighbour(ng2)==ind) THEN 
     856                DO k2=0,5 
     857                  IF (cell_glo(ind)%neighbour(k2)==ind2) THEN 
     858                    IF (k2==k+1 .OR. k2==k+2 .OR. k2+6==k+1 .AND. k2+6==k+2) THEN 
     859                      IF (cell_glo(ind1)%vertex(ng1)==0 .AND. cell_glo(ind2)%vertex(ng2)==0) THEN 
     860                        ne=ne+1 
     861                        cell_glo(ind)%vertex(k)=ne  
     862                        cell_glo(ind1)%vertex(ng1)=ne 
     863                        cell_glo(ind2)%vertex(ng2)=ne 
     864                      ELSE IF (cell_glo(ind1)%vertex(ng1)==0) THEN 
     865                        cell_glo(ind)%vertex(k)=cell_glo(ind2)%vertex(ng2) 
     866                        cell_glo(ind1)%vertex(ng1)=cell_glo(ind2)%vertex(ng2) 
     867                      ELSE IF (cell_glo(ind2)%vertex(ng2)==0) THEN 
     868                        cell_glo(ind)%vertex(k)=cell_glo(ind1)%vertex(ng1) 
     869                        cell_glo(ind2)%vertex(ng2)=cell_glo(ind1)%vertex(ng1) 
     870                      ENDIF 
     871                    ENDIF 
     872                  ENDIF 
     873                ENDDO 
     874              ENDIF 
     875            ENDDO 
     876          ENDDO 
     877        ENDIF 
     878      ENDDO 
     879    ENDDO                       
     880                      
     881  
     882  END SUBROUTINE set_cell_vertex 
     883 
     884         
    826885  SUBROUTINE set_vertex_edge 
    827886  IMPLICIT NONE 
    … …  
    850909      ENDDO 
    851910    ENDDO 
     911 
     912 
    852913  END SUBROUTINE set_vertex_edge  
    853914      
    … …  
    864925    CALL compute_extended_face_bis 
    865926    CALL set_cell_edge 
     927    CALL set_cell_vertex 
    866928    CALL set_vertex_edge 
    867929     
Note: See TracChangeset for help on using the changeset viewer.