Changeset 146


Ignore:
Timestamp:
03/12/13 16:34:45 (11 years ago)
Author:
ymipsl
Message:

Set constant sign for wind way :
ne(ij,right)==ne_right=1
ne(ij,rup)==ne_rup=-1
ne(ij,lup)==ne_lup=1
ne(ij,left)==ne_left=-1
ne(ij,ldown)==ne_ldown=1
ne(ij,rdown)==ne_rdown=-1

Modified transfert function to be compliant for this convention.

YM

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

Legend:

Unmodified
Added
Removed

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

    r145 r146  
    4040    USE mpipara 
    4141    USE trace 
     42    USE write_field 
    4243    IMPLICIT NONE 
    4344     
    … …  
    5556    CALL trace_start("advect_tracer")  
    5657 
    57     CALL transfert_request(f_u,req_e1) 
     58    CALL transfert_request(f_u,req_e1_vect) 
    5859!    CALL transfert_request(f_hfluxt,req_e1)  ! BUG : This (unnecessary) transfer makes the computation go wrong 
    5960    CALL transfert_request(f_wfluxt,req_i1) 
    … …  
    113114    CALL transfert_request(f_q,req_i1)      ! necessary ? 
    114115    CALL transfert_request(f_rhodz,req_i1)  ! necessary ? 
    115      
    116     CALL trace_end("advect_tracer") 
    117       
    118116 
    119117    ! horizontal transport - split in two to place transfer of gradq3d 
    … …  
    141139       END DO 
    142140    END DO  
    143  
     141     
    144142    CALL transfert_request(f_q,req_i1)      ! necessary ? 
    145143    CALL transfert_request(f_rhodz,req_i1)  ! necessary ? 
    146  
     144     
    147145    ! 1/2 vertical transport 
    148146    DO ind=1,ndomain 
    … …  
    156154       END DO 
    157155    END DO 
     156 
     157    CALL trace_end("advect_tracer") 
    158158 
    159159  END SUBROUTINE advect_tracer 

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

    r139 r146  
    1111  USE icosa 
    1212  USE caldyn_gcm_mod, ONLY : init_caldyn_gcm=>init_caldyn 
     13  USE caldyn_gcm_opt_mod, ONLY : init_caldyn_gcm_opt=>init_caldyn 
    1314  USE caldyn_adv_mod, ONLY : init_caldyn_adv=>init_caldyn 
    1415  IMPLICIT NONE 
    … …  
    2021      CASE('gcm') 
    2122        CALL init_caldyn_gcm 
     23      CASE('gcm_opt') 
     24        CALL init_caldyn_gcm_opt 
    2225      CASE('adv') 
    2326        CALL init_caldyn_adv 
    … …  
    3437  USE icosa 
    3538  USE caldyn_gcm_mod, ONLY : caldyn_gcm=>caldyn 
     39  USE caldyn_gcm_opt_mod, ONLY : caldyn_gcm_opt=>caldyn 
    3640  USE caldyn_adv_mod, ONLY : caldyn_adv=>caldyn 
    3741  IMPLICIT NONE 
    … …  
    5256        CALL caldyn_gcm(write_out,f_phis, f_ps, f_theta_rhodz, f_u, f_q, & 
    5357             f_hflux, f_wflux, f_dps, f_dtheta_rhodz, f_du) 
     58      CASE('gcm_opt') 
     59        CALL caldyn_gcm_opt(write_out,f_phis, f_ps, f_theta_rhodz, f_u, f_q, & 
     60             f_hflux, f_wflux, f_dps, f_dtheta_rhodz, f_du) 
    5461      CASE('adv') 
    5562        CALL caldyn_adv(write_out,f_phis, f_ps, f_theta_rhodz, f_u, f_q, & 

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

    r139 r146  
    7575 
    7676    CALL transfert_request(f_ps,req_i1)  
    77     CALL transfert_request(f_u,req_e1) 
     77    CALL transfert_request(f_u,req_e1_vect) 
    7878 
    7979    DO ind=1,ndomain 

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

    r145 r146  
    114114    CALL transfert_request(f_ps,req_i1)  
    115115    CALL transfert_request(f_theta_rhodz,req_i1)  
    116     CALL transfert_request(f_u,req_e1) 
     116    CALL transfert_request(f_u,req_e1_vect) 
    117117 
    118118    SELECT CASE(caldyn_conserv) 
    … …  
    131131       ENDDO 
    132132 
    133        CALL transfert_request(f_qu,req_e1) 
     133       CALL transfert_request(f_qu,req_e1_scal) 
    134134 
    135135       DO ind=1,ndomain 
    … …  
    419419      ij=(j-1)*iim+i 
    420420      wflux(ij,1)  = 0. 
     421      wflux(ij,llm+1)  = 0. 
    421422      ! dps/dt = -int(div flux)dz 
    422423      dps(ij)=-divm(ij,1) * g  
    … …  
    475476          ENDDO 
    476477       ENDDO 
    477  
     478        
    478479    CASE(enstrophy) ! enstrophy-conserving TRiSK 
    479480   

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

    r44 r146  
    7979  ENDDO 
    8080 
    81   CALL create_request(field_u,req_u) 
     81  CALL create_request(field_u,req_u,.TRUE.) 
    8282  DO ind=1,ndomain 
    8383    DO i=ii_begin,ii_end 
    … …  
    138138   
    139139    CALL transfert_request(f_h,req_i1)  
    140     CALL transfert_request(f_u,req_e1) 
    141     CALL transfert_request(f_u,req_e1)  
     140    CALL transfert_request(f_u,req_e1_vect) 
     141    CALL transfert_request(f_u,req_e1_vect)  
    142142    
    143143 

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

    r19 r146  
    5858   
    5959    CALL transfert_request(f_h,req_i1)  
    60     CALL transfert_request(f_u,req_e1) 
     60    CALL transfert_request(f_u,req_e1_vect) 
    6161    CALL transfert_request(f_u,req_e1)  
    6262    

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

    r145 r146  
    205205      dumax=0 
    206206      DO iter=1,nitergdiv 
    207         CALL transfert_request(f_u,req_e1) 
     207        CALL transfert_request(f_u,req_e1_vect) 
    208208        DO ind=1,ndomain 
    209209          CALL swap_dimensions(ind) 
    … …  
    216216      ENDDO 
    217217 
    218       CALL transfert_request(f_du,req_e1) 
     218      CALL transfert_request(f_du,req_e1_vect) 
    219219       
    220220      DO ind=1,ndomain 
    … …  
    282282      dumax=0 
    283283      DO iter=1,nitergrot 
    284         CALL transfert_request(f_u,req_e1) 
     284        CALL transfert_request(f_u,req_e1_vect) 
    285285        DO ind=1,ndomain 
    286286          CALL swap_dimensions(ind) 
    … …  
    293293      ENDDO 
    294294 
    295       CALL transfert_request(f_du,req_e1) 
     295      CALL transfert_request(f_du,req_e1_vect) 
    296296       
    297297      DO ind=1,ndomain 
    … …  
    557557    DO it=1,nitergdiv 
    558558         
    559       CALL transfert_request(f_due,req_e1) 
     559      CALL transfert_request(f_due,req_e1_vect) 
    560560         
    561561      DO ind=1,ndomain 
    … …  
    595595    DO it=1,nitergrot 
    596596         
    597       CALL transfert_request(f_due,req_e1) 
     597      CALL transfert_request(f_due,req_e1_vect) 
    598598         
    599599      DO ind=1,ndomain 

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

    r98 r146  
    4848    CALL allocate_field(f_u,field_u,type_real) 
    4949    CALL allocate_field(f_du,field_u,type_real) 
    50     CALL create_request(field_u,req_dissip) 
     50    CALL create_request(field_u,req_dissip,.TRUE.) 
    5151 
    5252    DO ind=1,ndomain 

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

    r26 r146  
    2323    INTEGER,POINTER  :: edge_assign_j(:,:,:) 
    2424    INTEGER,POINTER  :: edge_assign_pos(:,:,:) 
     25    INTEGER,POINTER  :: edge_assign_sign(:,:,:) 
    2526    REAL,POINTER     :: xyz(:,:,:) 
    2627    REAL,POINTER     :: neighbour(:,:,:,:) 
    … …  
    134135          ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm)) 
    135136          ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm)) 
     137          ALLOCATE(d%edge_assign_sign(0:5,d%iim,d%jjm)) 
    136138          ALLOCATE(d%delta(d%iim,d%jjm)) 
    137139          ALLOCATE(d%xyz(3,d%iim,d%jjm)) 
    … …  
    171173    d2%edge_assign_j => d1%edge_assign_j 
    172174    d2%edge_assign_pos => d1%edge_assign_pos 
     175    d2%edge_assign_sign => d1%edge_assign_sign 
    173176    d2%xyz => d1%xyz 
    174177    d2%neighbour => d1%neighbour 
    … …  
    210213  IMPLICIT NONE 
    211214    INTEGER :: ind_d,ind,ind2,e 
    212     INTEGER :: nf 
     215    INTEGER :: nf,nf2 
    213216    INTEGER :: i,j,k,ii,jj 
    214217    TYPE(t_domain),POINTER :: d 
    … …  
    257260            ind2=vertex_glo(ii,jj,nf)%neighbour(k) 
    258261            d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:) 
    259             d%ne(k,i,j)=vertex_glo(ii,jj,nf)%ne(k) 
     262 
     263!            d%ne(k,i,j)=vertex_glo(ii,jj,nf)%ne(k) 
     264            d%ne(k,i,j)=1-2*MOD(k,2) 
     265 
    260266            e=cell_glo(ind)%edge(MOD(k+delta+6,6)) 
    261267            d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain 
    … …  
    263269            d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j 
    264270            d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos 
     271            nf2=domain_glo(edge_glo(e)%assign_domain)%face 
     272            d%edge_assign_sign(k,i,j)=1-2*MOD(12+tab_index(nf,nf2,0),2) 
     273            IF (MOD(6+k+tab_index(nf,nf2,0),6)/=edge_glo(e)%assign_pos .AND. MOD(6+k+tab_index(nf,nf2,0),6) /= MOD(edge_glo(e)%assign_pos+3,6)) THEN 
     274              d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j) 
     275            ENDIF 
     276              
    265277          ENDDO 
    266278          d%xyz(:,i,j)=cell_glo(ind)%xyz(:) 
    … …  
    284296      edge_glo(e)%assign_j=j 
    285297      edge_glo(e)%assign_pos=k 
     298      edge_glo(e)%assign_delta=delta 
    286299!      PRINT*,"Assign_edge",ind_d,ind,i,j,k,e 
    287300     END  SUBROUTINE assign_edge 

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

    r47 r146  
    4949      
    5050 
    51  
     51  INTEGER, PARAMETER :: ne_right=1 
     52  INTEGER, PARAMETER :: ne_rup=-1 
     53  INTEGER, PARAMETER :: ne_lup=1 
     54  INTEGER, PARAMETER :: ne_left=-1 
     55  INTEGER, PARAMETER :: ne_ldown=1 
     56  INTEGER, PARAMETER :: ne_rdown=-1 
     57   
    5258CONTAINS 
    5359 

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

    r19 r146  
    1414    INTEGER :: ind 
    1515   
    16     CALL transfert_request(f_ue,req_e1) 
    17     CALL transfert_request(f_ue,req_e1) 
     16    CALL transfert_request(f_ue,req_e1_vect) 
     17    CALL transfert_request(f_ue,req_e1_vect) 
    1818 
    1919    DO ind=1,ndomain 

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

    r131 r146  
    2929   INTEGER :: assign_j 
    3030   INTEGER :: assign_pos 
     31   INTEGER :: assign_delta 
    3132  END TYPE t_edge_glo 
    3233     

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

    r110 r146  
    4040    INTEGER :: ind 
    4141 
    42     CALL transfert_request(f_ue,req_e1) 
     42    CALL transfert_request(f_ue,req_e1_vect) 
    4343    DO ind=1,ndomain 
    4444      CALL swap_dimensions(ind) 

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

    r145 r146  
    408408    LOGICAL, INTENT(IN) :: comp ! .TRUE. to compute, .FALSE. to check 
    409409    REAL(rstd), INTENT(IN) :: ps(iim*jjm) 
    410     REAL(rstd), INTENT(OUT) :: rhodz(iim*jjm,llm) 
     410    REAL(rstd), INTENT(INOUT) :: rhodz(iim*jjm,llm) 
    411411    REAL(rstd) :: m, err 
    412412    INTEGER :: l,i,j,ij,dd 

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

    r31 r146  
    22 
    33#ifdef CPP_USING_MPI 
    4   USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1, & 
    5                                 request_add_point, create_request, gather_field 
     4  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, & 
     5                                req_e1_scal,request_add_point, create_request, gather_field 
    66#else  
    7   USE transfert_mpi_mod, ONLY : init_transfert, transfert_request, req_i1,req_e1, & 
    8                                 request_add_point, create_request, gather_field 
     7  USE transfert_mpi_mod, ONLY : init_transfert, transfert_request, req_i1,req_e1_vect, & 
     8                                req_e1_scal,request_add_point, create_request, gather_field 
    99#endif 
    1010   

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

    r74 r146  
    44  TYPE array 
    55    INTEGER,POINTER :: value(:) 
     6    INTEGER,POINTER :: sign(:) 
    67    INTEGER         :: domain 
    78    INTEGER         :: rank 
    … …  
    1718    INTEGER :: max_size 
    1819    INTEGER :: size 
     20    LOGICAL :: vector 
    1921    INTEGER,POINTER :: src_domain(:) 
    2022    INTEGER,POINTER :: src_i(:) 
    … …  
    2426    INTEGER,POINTER :: target_i(:) 
    2527    INTEGER,POINTER :: target_j(:) 
     28    INTEGER,POINTER :: target_sign(:) 
    2629    INTEGER :: nrecv 
    2730    TYPE(ARRAY),POINTER :: recv(:) 
    … …  
    3134   
    3235  TYPE(t_request),POINTER :: req_i1(:) 
    33   TYPE(t_request),POINTER :: req_e1(:) 
     36  TYPE(t_request),POINTER :: req_e1_scal(:) 
     37  TYPE(t_request),POINTER :: req_e1_vect(:) 
    3438   
    3539   
    … …  
    8488    CALL finalize_request(req_i1) 
    8589   
    86     CALL create_request(field_u,req_e1) 
     90    CALL create_request(field_u,req_e1_scal) 
    8791    DO ind=1,ndomain 
    8892      CALL swap_dimensions(ind) 
    8993      DO i=ii_begin,ii_end 
    90         CALL request_add_point(ind,i,jj_begin-1,req_e1,rup) 
    91         CALL request_add_point(ind,i+1,jj_begin-1,req_e1,lup) 
     94        CALL request_add_point(ind,i,jj_begin-1,req_e1_scal,rup) 
     95        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_scal,lup) 
    9296      ENDDO 
    9397 
    9498      DO j=jj_begin,jj_end 
    95         CALL request_add_point(ind,ii_end+1,j,req_e1,left) 
    96         CALL request_add_point(ind,ii_end+1,j-1,req_e1,lup) 
     99        CALL request_add_point(ind,ii_end+1,j,req_e1_scal,left) 
     100        CALL request_add_point(ind,ii_end+1,j-1,req_e1_scal,lup) 
    97101      ENDDO     
    98102     
    99103      DO i=ii_begin,ii_end 
    100         CALL request_add_point(ind,i,jj_end+1,req_e1,ldown) 
    101         CALL request_add_point(ind,i-1,jj_end+1,req_e1,rdown) 
     104        CALL request_add_point(ind,i,jj_end+1,req_e1_scal,ldown) 
     105        CALL request_add_point(ind,i-1,jj_end+1,req_e1_scal,rdown) 
    102106      ENDDO     
    103107 
    104108      DO j=jj_begin,jj_end 
    105         CALL request_add_point(ind,ii_begin-1,j,req_e1,right) 
    106         CALL request_add_point(ind,ii_begin-1,j+1,req_e1,rdown) 
     109        CALL request_add_point(ind,ii_begin-1,j,req_e1_scal,right) 
     110        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_scal,rdown) 
    107111      ENDDO    
    108112 
    109113      DO i=ii_begin+1,ii_end-1 
    110         CALL request_add_point(ind,i,jj_begin,req_e1,right) 
    111         CALL request_add_point(ind,i,jj_end,req_e1,right) 
     114        CALL request_add_point(ind,i,jj_begin,req_e1_scal,right) 
     115        CALL request_add_point(ind,i,jj_end,req_e1_scal,right) 
    112116      ENDDO 
    113117     
    114118      DO j=jj_begin+1,jj_end-1 
    115         CALL request_add_point(ind,ii_begin,j,req_e1,rup) 
    116         CALL request_add_point(ind,ii_end,j,req_e1,rup) 
     119        CALL request_add_point(ind,ii_begin,j,req_e1_scal,rup) 
     120        CALL request_add_point(ind,ii_end,j,req_e1_scal,rup) 
    117121      ENDDO    
    118122 
    119       CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1,left) 
    120       CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1,ldown) 
    121       CALL request_add_point(ind,ii_begin+1,jj_end,req_e1,left) 
    122       CALL request_add_point(ind,ii_end,jj_begin+1,req_e1,ldown) 
    123  
    124       CALL finalize_request(req_e1) 
    125       
    126     ENDDO 
    127    
     123      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1_scal,left) 
     124      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1_scal,ldown) 
     125      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1_scal,left) 
     126      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1_scal,ldown) 
     127 
     128    ENDDO 
     129 
     130    CALL finalize_request(req_e1_scal) 
     131     
     132    CALL create_request(field_u,req_e1_vect,.TRUE.) 
     133    DO ind=1,ndomain 
     134      CALL swap_dimensions(ind) 
     135      DO i=ii_begin,ii_end 
     136        CALL request_add_point(ind,i,jj_begin-1,req_e1_vect,rup) 
     137        CALL request_add_point(ind,i+1,jj_begin-1,req_e1_vect,lup) 
     138      ENDDO 
     139 
     140      DO j=jj_begin,jj_end 
     141        CALL request_add_point(ind,ii_end+1,j,req_e1_vect,left) 
     142        CALL request_add_point(ind,ii_end+1,j-1,req_e1_vect,lup) 
     143      ENDDO     
     144     
     145      DO i=ii_begin,ii_end 
     146        CALL request_add_point(ind,i,jj_end+1,req_e1_vect,ldown) 
     147        CALL request_add_point(ind,i-1,jj_end+1,req_e1_vect,rdown) 
     148      ENDDO     
     149 
     150      DO j=jj_begin,jj_end 
     151        CALL request_add_point(ind,ii_begin-1,j,req_e1_vect,right) 
     152        CALL request_add_point(ind,ii_begin-1,j+1,req_e1_vect,rdown) 
     153      ENDDO    
     154 
     155      DO i=ii_begin+1,ii_end-1 
     156        CALL request_add_point(ind,i,jj_begin,req_e1_vect,right) 
     157        CALL request_add_point(ind,i,jj_end,req_e1_vect,right) 
     158      ENDDO 
     159     
     160      DO j=jj_begin+1,jj_end-1 
     161        CALL request_add_point(ind,ii_begin,j,req_e1_vect,rup) 
     162        CALL request_add_point(ind,ii_end,j,req_e1_vect,rup) 
     163      ENDDO    
     164 
     165      CALL request_add_point(ind,ii_begin+1,jj_begin,req_e1_vect,left) 
     166      CALL request_add_point(ind,ii_begin,jj_begin+1,req_e1_vect,ldown) 
     167      CALL request_add_point(ind,ii_begin+1,jj_end,req_e1_vect,left) 
     168      CALL request_add_point(ind,ii_end,jj_begin+1,req_e1_vect,ldown) 
     169 
     170   
     171    ENDDO   
     172 
     173    CALL finalize_request(req_e1_vect) 
     174 
    128175  END SUBROUTINE init_transfert 
    129176   
    130   SUBROUTINE create_request(type_field,request) 
     177  SUBROUTINE create_request(type_field,request,vector) 
    131178  USE domain_mod 
    132179  USE field_mod 
    … …  
    134181    INTEGER :: type_field 
    135182    TYPE(t_request),POINTER :: request(:) 
     183    LOGICAL,OPTIONAL :: vector 
     184     
    136185    TYPE(t_request),POINTER :: req 
    137186    TYPE(t_domain),POINTER :: d 
    138187    INTEGER :: ind 
    139188    INTEGER :: max_size 
    140          
     189        
    141190    ALLOCATE(request(ndomain)) 
    142191 
    … …  
    155204      req%max_size=max_size*2 
    156205      req%size=0 
     206      req%vector=.FALSE. 
     207      IF (PRESENT(vector)) req%vector=vector 
    157208      ALLOCATE(req%src_domain(req%max_size)) 
    158209      ALLOCATE(req%src_ind(req%max_size)) 
    … …  
    162213      ALLOCATE(req%target_i(req%max_size)) 
    163214      ALLOCATE(req%target_j(req%max_size)) 
     215      ALLOCATE(req%target_sign(req%max_size)) 
    164216    ENDDO 
    165217   
    … …  
    177229    INTEGER,POINTER :: target_i(:) 
    178230    INTEGER,POINTER :: target_j(:) 
     231    INTEGER,POINTER :: target_sign(:) 
    179232 
    180233    PRINT *,"REALLOCATE_REQUEST" 
    … …  
    186239    target_i=>req%target_i 
    187240    target_j=>req%target_j 
     241    target_sign=>req%target_sign 
    188242!    req%max_size=req%max_size*2 
    189243    ALLOCATE(req%src_domain(req%max_size*2)) 
    … …  
    194248    ALLOCATE(req%target_i(req%max_size*2)) 
    195249    ALLOCATE(req%target_j(req%max_size*2)) 
     250    ALLOCATE(req%target_sign(req%max_size*2)) 
    196251     
    197252    req%src_domain(1:req%max_size)=src_domain(:) 
    … …  
    202257    req%target_i(1:req%max_size)=target_i(:) 
    203258    req%target_j(1:req%max_size)=target_j(:) 
     259    req%target_sign(1:req%max_size)=target_sign(:) 
    204260     
    205261    req%max_size=req%max_size*2 
    … …  
    212268    DEALLOCATE(target_i) 
    213269    DEALLOCATE(target_j) 
     270    DEALLOCATE(target_sign) 
    214271 
    215272  END SUBROUTINE reallocate_request 
    … …  
    243300 
    244301        req%target_ind(req%size)=(j-1)*d%iim+i 
     302        req%target_sign(req%size)=1 
    245303        req%src_domain(req%size)=src_domain 
    246304        req%src_ind(req%size)=(src_j-1)*src_iim+src_i 
    … …  
    254312        src_n=(src_j-1)*src_iim+src_i 
    255313        src_delta=domain(ind)%delta(i,j) 
    256          
    257 !        src_pos=MOD(pos-1+src_delta+6,6)+1 
    258314        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1 
    259315                 
    260316        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos) 
     317 
     318        req%target_sign(req%size)= 1 
     319        IF (req%vector) req%target_sign(req%size)= domain(ind)%edge_assign_sign(pos-1,i,j) 
     320 
    261321        req%src_domain(req%size)=src_domain 
    262322        req%src_ind(req%size)=src_n+domain_glo(src_domain)%u_pos(src_pos) 
    263  
    264 !        req%target_i(req%size)=i 
    265 !        req%target_j(req%size)=j 
    266 !        req%src_i(req%size)=domain(ind)%assign_i(i,j) 
    267 !        req%src_j(req%size)=domain(ind)%assign_j(i,j) 
    268          
    269 !        PRINT *,"1--->",ind,i,j,pos 
    270 !        PRINT *,"2--->",src_domain,src_i,src_j,src_pos 
    271323 
    272324      ELSE IF (req%type_field==field_z) THEN 
    … …  
    283335         
    284336        req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos) 
     337        req%target_sign(req%size)=1 
    285338        req%src_domain(req%size)=src_domain 
    286339        req%src_ind(req%size)=src_n+domain_glo(src_domain)%z_pos(src_pos) 
    … …  
    338391          req%recv(irecv)%domain=domglo_loc_ind(ind_glo) 
    339392          ALLOCATE(req%recv(irecv)%value(req%recv(irecv)%size)) 
     393          ALLOCATE(req%recv(irecv)%sign(req%recv(irecv)%size)) 
    340394          ALLOCATE(req%recv(irecv)%buffer(req%recv(irecv)%size)) 
    341395        ENDIF 
    … …  
    350404        req%recv(irecv)%value(size)=req%src_ind(i) 
    351405        req%recv(irecv)%buffer(size)=req%target_ind(i) 
     406        req%recv(irecv)%sign(size)=req%target_sign(i) 
    352407      ENDDO 
    353408    ENDDO 
    … …  
    362417      ENDDO 
    363418    ENDDO 
    364      
    365419     
    366420    CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr)      
    … …  
    465519     DO irecv=1,req%nrecv 
    466520       req%recv(irecv)%value(:)=req%recv(irecv)%buffer(:) 
     521       req%recv(irecv)%sign(:) =req%recv(irecv)%sign(:) 
    467522       DEALLOCATE(req%recv(irecv)%buffer) 
    468523     ENDDO 
    … …  
    470525    
    471526     
    472 !   nb_domain_recv(:)=0 
    473 !   nb_data_domain_recv(:)=0 
    474 !    
    475 !   DO ind_loc=1,ndomain 
    476 !    
    477 !     DO i=1,req%size 
    478 !       ind_glo=req%src_domain(i) 
    479 !       nb_data_domain_recv(ind_glo)=nb_data_domain_recv(ind_glo)+1 
    480 !     ENDDO 
    481 !    
    482 !     DO ind_glo=1,ndomain_glo 
    483 !       IF ( nb_data_domain_recv(ind_glo) > 0 )  nb_domain_recv(domglo_rank(ind_glo))=nb_domain_recv(domglo_rank(ind_glo))+1 
    484 !     ENDDO 
    485 !        
    486 !     CALL MPI_Alltoall(nb_domain_recv,1,MPI_INTEGER,nb_domain_send,1,MPI_INTEGER,comm_icosa,ierr) 
    487 !   ENDDO 
    488 !    
    489 !   DO  
    490 !   recv=sum(nb_domain_recv(:)) 
    491 !   send=sum(nb_domain_send(:)) 
    492  
    493 !   ALLOCATE(req%recv(recv)) 
    494 !   ALLOCATE(req%send(send)) 
    495  
    496 !   ALLOCATE(mpi_req(2*(send+recv))) 
    497 !   ALLOCATE(status(MPI_STATUS_SIZE,2*(send+recv))) 
    498 !    
    499 !   recv=0 
    500 !   ireq=0 
    501 !   DO ind_glo=1,ndomain_glo 
    502 !     IF (nb_data_domain_recv(ind_glo)>0) THEN 
    503 !       recv=recv+1 
    504 !       list_domain_recv(ind_glo)=recv 
    505 !       req%recv(recv)%rank=domglo_rank(ind_glo) 
    506 !       req%recv(recv)%size=nb_data_domain_recv(ind_glo) 
    507 !       req%recv(recv)%domain=domglo_loc_ind(ind_glo) 
    508 !       ALLOCATE(req%recv(recv)%value(req%recv(recv)%size)) 
    509 !       ireq=ireq+1 
    510 !       CALL MPI_ISEND(req%recv(recv)%domain,1,MPI_INTEGER,req%recv(recv)%rank,0,comm_icosa, mpi_req(ireq),ierr) 
    511 !       ireq=ireq+1 
    512 !       CALL MPI_ISEND(req%recv(recv)%size,1,MPI_INTEGER,req%recv(recv)%rank,0,comm_icosa, mpi_req(ireq),ierr) 
    513 !     ENDIF 
    514 !   ENDDO 
    515 !    
    516 !     
    517 !   send=0 
    518 !   DO rank=0,mpi_size-1 
    519 !     DO j=1,nb_domain_send(rank) 
    520 !       send=send+1 
    521 !       req%send(send)%rank=rank 
    522 !       ireq=ireq+1 
    523 !       CALL MPI_IRECV(req%send(send)%domain,1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr) 
    524 !       ireq=ireq+1 
    525 !       CALL MPI_IRECV(req%send(send)%size,1,MPI_INTEGER,rank,0,comm_icosa, mpi_req(ireq),ierr) 
    526 !     ENDDO 
    527 !   ENDDO 
    528 !    
    529 !   CALL MPI_WAITALL(2*(send+recv),mpi_req,status,ierr)  
    530  
    531 !   req%recv(:)%size=0 
    532 !    
    533 !   DO i=1,req%size 
    534 !     j=list_domain_recv(req%src_domain(i)) 
    535 !     req%recv(j)%size=req%recv(j)%size+1 
    536 !     size=req%recv(j)%size 
    537 !     req%recv(j)%value(size)=req%src_ind(i) 
    538 !   ENDDO 
    539 !        
    540 !   ireq=0 
    541 !   DO i=1,recv 
    542 !     ireq=ireq+1 
    543 !     CALL MPI_ISEND(req%recv(i)%value,req%recv(i)%size,MPI_INTEGER,req%recv(i)%rank,req%recv(i)%domain,comm_icosa, mpi_req(ireq),ierr)    
    544 !   ENDDO 
    545  
    546 !   DO i=1,send 
    547 !     ireq=ireq+1 
    548 !     ALLOCATE(req%send(i)%value(req%send(i)%size)) 
    549 !     CALL MPI_IRECV(req%send(i)%value,req%send(i)%size,MPI_INTEGER,req%send(i)%rank,req%send(i)%domain,comm_icosa, mpi_req(ireq),ierr)    
    550 !   ENDDO 
    551 !    
    552 !   CALL MPI_WAITALL(send+recv,mpi_req,status,ierr)  
    553      
    554  
    555    END SUBROUTINE Finalize_request  
     527  END SUBROUTINE Finalize_request  
    556528 
    557529 
    … …  
    571543    REAL(rstd),POINTER :: buffer_r4(:,:,:)  
    572544    INTEGER,POINTER :: value(:)  
     545    INTEGER,POINTER :: sgn(:)  
    573546    TYPE(ARRAY),POINTER :: recv,send  
    574547    TYPE(t_request),POINTER :: req 
    … …  
    634607            buffer_r2=>recv%buffer_r2 
    635608            value=>recv%value 
     609            sgn=>recv%sign 
    636610            DO n=1,recv%size 
    637               rval2d(value(n))=buffer_r2(n)   
     611              rval2d(value(n))=buffer_r2(n)*sgn(n)   
    638612            ENDDO         
    639613            DEALLOCATE(recv%buffer_r2) 
    … …  
    697671            buffer_r3=>recv%buffer_r3 
    698672            value=>recv%value 
     673            sgn=>recv%sign 
    699674            DO n=1,recv%size 
    700               rval3d(value(n),:)=buffer_r3(n,:)   
     675              rval3d(value(n),:)=buffer_r3(n,:)*sgn(n)   
    701676            ENDDO         
    702677            DEALLOCATE(recv%buffer_r3) 
    … …  
    760735            buffer_r4=>recv%buffer_r4 
    761736            value=>recv%value 
     737            sgn=>recv%sign 
    762738            DO n=1,recv%size 
    763               rval4d(value(n),:,:)=buffer_r4(n,:,:)   
     739              rval4d(value(n),:,:)=buffer_r4(n,:,:)*sgn(n)  
    764740            ENDDO         
    765741            DEALLOCATE(recv%buffer_r4) 
    … …  
    797773        IF (field(ind)%ndim==2) THEN 
    798774          DO n=1,req%size 
    799             rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n)) 
     775            rval2d(req%target_ind(n))=field(req%src_domain(n))%rval2d(req%src_ind(n))*req%target_sign(n) 
    800776          ENDDO 
    801777        ELSE IF (field(ind)%ndim==3) THEN 
    802778          DO n=1,req%size 
    803             rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:) 
     779            rval3d(req%target_ind(n),:)=field(req%src_domain(n))%rval3d(req%src_ind(n),:)*req%target_sign(n) 
    804780          ENDDO 
    805781        ELSE IF (field(ind)%ndim==4) THEN 
    806782          DO n=1,req%size 
    807             rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:) 
     783            rval4d(req%target_ind(n),:,:)=field(req%src_domain(n))%rval4d(req%src_ind(n),:,:)*req%target_sign(n) 
    808784          ENDDO 
    809785        ENDIF 

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

    r19 r146  
    1313    INTEGER :: ind 
    1414 
    15     CALL transfert_request(f_ue,req_e1) 
    16     CALL transfert_request(f_ue,req_e1) 
     15    CALL transfert_request(f_ue,req_e1_vect) 
    1716    
    1817    DO ind=1,ndomain 
Note: See TracChangeset for help on using the changeset viewer.