Changeset 711


Ignore:
Timestamp:
07/25/18 13:57:35 (6 years ago)
Author:
ymipsl
Message:

Adding halo transfer for scalar field ad vorticity point.
=> Use request "req_z1_scal" with transfer function

YM

Location:
codes/icosagcm/trunk/src
Files:
4 edited

Legend:

Unmodified
Added
Removed

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

    r548 r711  
    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/trunk/src/parallel/transfert.F90

    r548 r711  
    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/trunk/src/parallel/transfert_mpi.f90

    r667 r711  
    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/trunk/src/sphere/metric.f90

    r548 r711  
    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.