Changeset 21


Ignore:
Timestamp:
07/18/12 11:15:39 (12 years ago)
Author:
ymipsl
Message:

correction for compiling with gfortran (line too long)
improvement for splitting domain
Call twice transfert request for field u is no longer necessary

YM

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

Legend:

Unmodified
Added
Removed

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

    r19 r21  
    112112  REAL(rstd),POINTER :: dtheta_rhodz(:,:) 
    113113  REAL(rstd),POINTER :: du(:,:) 
    114   INTEGER :: ind 
     114  INTEGER :: ind,ij 
    115115 
    116116   
    … …  
    119119    CALL transfert_request(f_theta_rhodz,req_i1)  
    120120    CALL transfert_request(f_u,req_e1) 
    121     CALL transfert_request(f_u,req_e1)  
     121!    CALL transfert_request(f_u,req_e1)  
    122122    
    123123 
    … …  
    136136      dtheta_rhodz=f_dtheta_rhodz(ind) 
    137137      du=f_du(ind) 
    138        
     138!      ij=(jj_end-1-1)*iim+ii_begin 
     139!      PRINT *,"--> ind=",ind,ij 
     140!      PRINT *,u(ij+u_right,1) 
     141!      PRINT *,u(ij+u_rup,1) 
     142!      PRINT *,u(ij+u_lup,1) 
     143!      PRINT *,u(ij+u_left,1) 
     144!      PRINT *,u(ij+u_ldown,1) 
     145!      PRINT *,u(ij+u_rdown,1) 
     146 
     147!      ij=(jj_end-1-1)*iim+ii_end 
     148!      PRINT *,"--> ind=",ind,ij 
     149!      PRINT *,u(ij+u_right,1) 
     150!      PRINT *,u(ij+u_rup,1) 
     151!      PRINT *,u(ij+u_lup,1) 
     152!      PRINT *,u(ij+u_left,1) 
     153!      PRINT *,u(ij+u_ldown,1) 
     154!      PRINT *,u(ij+u_rdown,1)       
    139155!$OMP PARALLEL DEFAULT(SHARED) 
    140156      CALL compute_caldyn(phis, ps, theta_rhodz, u, dps, dtheta_rhodz, du) 
    … …  
    143159 
    144160    CALL transfert_request(f_out_u,req_e1) 
    145     CALL transfert_request(f_out_u,req_e1)  
     161!    CALL transfert_request(f_out_u,req_e1)  
    146162 
    147163!    CALL vorticity(f_u,f_out_z) 
    148 !    CALL kinetic(f_du,f_out) 
    149164 
    150165    IF (mod(it,itau_out)==0 ) THEN 
    151166      CALL writefield("ps",f_ps) 
    152 !      CALL writefield("dps",f_dps) 
     167      CALL writefield("dps",f_dps) 
    153168!      CALL writefield("theta_rhodz",f_theta_rhodz) 
     169!    CALL kinetic(f_u,f_out) 
     170!      CALL writefield("Ki",f_out) 
    154171!      CALL writefield("dtheta_rhodz",f_dtheta_rhodz) 
    155172      CALL vorticity(f_u,f_out_z) 
    … …  
    163180!        CALL writefield("Ki",f_out,ind) 
    164181!        CALL writefield("vort",f_out_z,ind) 
     182!        CALL writefield("dps",f_dps,ind) 
    165183!      ENDDO 
    166184 

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

    r15 r21  
    1919    INTEGER,POINTER  :: assign_i(:,:) 
    2020    INTEGER,POINTER  :: assign_j(:,:) 
     21    INTEGER,POINTER  :: edge_assign_domain(:,:,:) 
     22    INTEGER,POINTER  :: edge_assign_i(:,:,:) 
     23    INTEGER,POINTER  :: edge_assign_j(:,:,:) 
     24    INTEGER,POINTER  :: edge_assign_pos(:,:,:) 
    2125    REAL,POINTER     :: xyz(:,:,:) 
    2226    REAL,POINTER     :: neighbour(:,:,:,:) 
    … …  
    7175    ind=0 
    7276    DO nf=1,nb_face 
    73       DO nj=1,nsplit_i 
    74         DO ni=1,nsplit_j 
     77      DO nj=1,nsplit_j 
     78        DO ni=1,nsplit_i 
    7579          ind=ind+1 
    7680          d=>domain(ind) 
    … …  
    8589          ENDIF 
    8690          d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1 
     91  
     92          IF (ni/=nsplit_i) THEN  
     93            d%ii_nb=d%ii_nb+1 
     94            d%ii_end_glo=d%ii_end_glo+1 
     95          ENDIF 
     96          
    8797         
    8898          quotient=(jjm_glo/nsplit_j) 
    … …  
    95105            d%jj_begin_glo=(quotient+1)*rest+(nj-1-rest) * quotient+1 
    96106          ENDIF 
    97  
    98107          d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1 
     108 
     109          IF (nj/=nsplit_j) THEN  
     110            d%jj_nb=d%jj_nb+1 
     111            d%jj_end_glo=d%jj_end_glo+1 
     112          ENDIF 
     113 
     114 
    99115          d%iim=d%ii_nb+2*halo 
    100116          d%jjm=d%jj_nb+2*halo 
    … …  
    107123          ALLOCATE(d%assign_i(d%iim,d%jjm)) 
    108124          ALLOCATE(d%assign_j(d%iim,d%jjm)) 
     125          ALLOCATE(d%edge_assign_domain(0:5,d%iim,d%jjm)) 
     126          ALLOCATE(d%edge_assign_i(0:5,d%iim,d%jjm)) 
     127          ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm)) 
     128          ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm)) 
    109129          ALLOCATE(d%delta(d%iim,d%jjm)) 
    110130          ALLOCATE(d%xyz(3,d%iim,d%jjm)) 
    … …  
    123143  USE metric 
    124144  IMPLICIT NONE 
    125     INTEGER :: ind_d,ind,ind2 
     145    INTEGER :: ind_d,ind,ind2,e 
    126146    INTEGER :: nf 
    127147    INTEGER :: i,j,k,ii,jj 
    128148    TYPE(t_domain),POINTER :: d 
     149    INTEGER :: delta 
    129150      
    130151     
    … …  
    137158          jj=d%jj_begin_glo-d%jj_begin+j 
    138159          ind=vertex_glo(ii,jj,nf)%ind 
     160          delta=vertex_glo(ii,jj,nf)%delta 
    139161          IF (cell_glo(ind)%assign_face==nf) THEN  
    140162            cell_glo(ind)%assign_domain=ind_d 
    … …  
    142164            cell_glo(ind)%assign_j=j 
    143165          ENDIF 
     166          IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0) 
     167          IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1) 
     168          IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2) 
     169          IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3) 
     170          IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4) 
     171          IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5) 
    144172        ENDDO 
    145173      ENDDO 
    146174    ENDDO 
     175     
    147176     
    148177    DO ind_d=1,ndomain 
    … …  
    157186          d%assign_i(i,j)=cell_glo(ind)%assign_i 
    158187          d%assign_j(i,j)=cell_glo(ind)%assign_j 
     188          delta=vertex_glo(ii,jj,nf)%delta 
    159189          d%delta(i,j)=vertex_glo(ii,jj,nf)%delta 
    160190          DO k=0,5 
    … …  
    162192            d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:) 
    163193            d%ne(k,i,j)=vertex_glo(ii,jj,nf)%ne(k) 
     194            e=cell_glo(ind)%edge(MOD(k+delta+6,6)) 
     195            d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain 
     196            d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i 
     197            d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j 
     198            d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos 
    164199          ENDDO 
    165200          d%xyz(:,i,j)=cell_glo(ind)%xyz(:) 
    … …  
    171206        ENDDO 
    172207      ENDDO 
    173     ENDDO     
     208    ENDDO 
     209 
     210  CONTAINS 
     211 
     212    SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k) 
     213      INTEGER :: ind_d,ind,i,j,delta,k 
     214      INTEGER :: e 
     215      e=cell_glo(ind)%edge(MOD(k+delta+6,6)) 
     216      edge_glo(e)%assign_domain=ind_d 
     217      edge_glo(e)%assign_i=i 
     218      edge_glo(e)%assign_j=j 
     219      edge_glo(e)%assign_pos=k 
     220!      PRINT*,"Assign_edge",ind_d,ind,i,j,k,e 
     221     END  SUBROUTINE assign_edge 
     222          
    174223  END SUBROUTINE assign_cell 
    175224 

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

    r17 r21  
    257257    REAL(rstd) :: surf_v(6) 
    258258    REAL(rstd) :: vect(3,6) 
    259     REAL(rstd) :: centr(6) 
     259    REAL(rstd) :: centr(3) 
    260260    REAL(rstd) :: vet(3),vep(3) 
    261261    INTEGER :: ind,i,j,k,n 

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

    r15 r21  
    2525   INTEGER :: e1 
    2626   INTEGER :: e2 
     27   INTEGER :: assign_domain 
     28   INTEGER :: assign_i 
     29   INTEGER :: assign_j 
     30   INTEGER :: assign_pos 
    2731  END TYPE t_edge_glo 
    2832     

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

    r19 r21  
    9090  CALL init_caldyn(dt) 
    9191  CALL init_guided(dt) 
    92   CALL init_advect_tracer(dt) 
     92!  CALL init_advect_tracer(dt) 
    9393   
    9494  CALL etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    … …  
    9999    CALL guided(it,f_ps,f_theta_rhodz,f_u,f_q) 
    100100    CALL caldyn(it,f_phis,f_ps,f_theta_rhodz,f_u, f_dps, f_dtheta_rhodz, f_du) 
    101     CALL advect_tracer(f_ps,f_u,f_q) 
     101!    CALL advect_tracer(f_ps,f_u,f_q) 
    102102     
    103103    SELECT CASE (TRIM(scheme)) 
    … …  
    116116 
    117117      CASE default 
    118         PRINT*,'Bad selector for variable scheme : <', TRIM(scheme),"> options are <euler>, <leapfrog>, <leapfrog_matsuno>, <adam_bashforth>"  
     118        PRINT*,'Bad selector for variable scheme : <', TRIM(scheme),             & 
     119               ' > options are <euler>, <leapfrog>, <leapfrog_matsuno>, <adam_bashforth>' 
    119120        STOP 
    120121         

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

    r15 r21  
    227227      ELSE IF (req%type_field==field_u) THEN 
    228228        IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme' 
    229          
    230         src_domain=domain(ind)%assign_domain(i,j) 
     229 
     230        src_domain=domain(ind)%edge_assign_domain(pos-1,i,j) 
    231231        src_iim=domain(src_domain)%iim 
    232         src_i=domain(ind)%assign_i(i,j) 
    233         src_j=domain(ind)%assign_j(i,j) 
     232        src_i=domain(ind)%edge_assign_i(pos-1,i,j) 
     233        src_j=domain(ind)%edge_assign_j(pos-1,i,j) 
    234234        src_n=(src_j-1)*src_iim+src_i 
    235235        src_delta=domain(ind)%delta(i,j) 
    236236         
    237         src_pos=MOD(pos-1+src_delta+6,6)+1 
    238          
     237!        src_pos=MOD(pos-1+src_delta+6,6)+1 
     238        src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1 
     239                 
    239240        req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos) 
    240241        req%src_domain(req%size)=src_domain 
    241242        req%src_ind(req%size)=src_n+domain(src_domain)%u_pos(src_pos) 
    242243 
    243         req%target_i(req%size)=i 
    244         req%target_j(req%size)=j 
    245         req%src_i(req%size)=domain(ind)%assign_i(i,j) 
    246         req%src_j(req%size)=domain(ind)%assign_j(i,j) 
    247          
    248 !        PRINT *,ind,i,j,"src_delta",src_delta 
     244!        req%target_i(req%size)=i 
     245!        req%target_j(req%size)=j 
     246!        req%src_i(req%size)=domain(ind)%assign_i(i,j) 
     247!        req%src_j(req%size)=domain(ind)%assign_j(i,j) 
     248         
     249!        PRINT *,"1--->",ind,i,j,pos 
     250!        PRINT *,"2--->",src_domain,src_i,src_j,src_pos 
    249251 
    250252      ELSE IF (req%type_field==field_z) THEN 

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

    r19 r21  
    1818        DO i=ii_begin,ii_end 
    1919          ij=(j-1)*iim+i 
    20           ucenter(ij,:,l)=1/Ai(ij)*(  ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_i(ij+z_rup,:))/2  -centroid(ij,:))   & 
    21                                     + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_i(ij+z_up,:))/2-centroid(ij,:))             & 
    22                                     + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_i(ij+z_lup,:))/2-centroid(ij,:))             & 
    23                                     + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_i(ij+z_lup,:)+xyz_i(ij+z_ldown,:))/2-centroid(ij,:))       & 
    24                                     + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_i(ij+z_ldown,:)+xyz_i(ij+z_down,:))/2-centroid(ij,:))   & 
    25                                     + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_i(ij+z_down,:)+xyz_i(ij+z_rdown,:))/2-centroid(ij,:)) ) 
     20          ucenter(ij,:,l)=1/Ai(ij)*                                                                                                & 
     21                        ( ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_i(ij+z_rup,:))/2  -centroid(ij,:))& 
     22                         + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_i(ij+z_up,:))/2-centroid(ij,:))          & 
     23                         + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_i(ij+z_lup,:))/2-centroid(ij,:))          & 
     24                         + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_i(ij+z_lup,:)+xyz_i(ij+z_ldown,:))/2-centroid(ij,:))    & 
     25                         + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_i(ij+z_ldown,:)+xyz_i(ij+z_down,:))/2-centroid(ij,:))& 
     26                         + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_i(ij+z_down,:)+xyz_i(ij+z_rdown,:))/2-centroid(ij,:))) 
    2627        ENDDO 
    2728      ENDDO 

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

    r17 r21  
    154154            ENDDO 
    155155          ENDDO 
    156           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
     156          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,  & 
     157                              start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
    157158          DEALLOCATE(field_val2d) 
    158159        ELSE IF (field(ind)%ndim==3) THEN 
    … …  
    238239          ENDDO 
    239240 
    240           status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
     241          status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),                       & 
     242                              Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 
    241243          DEALLOCATE(field_val2d) 
    242244 
    … …  
    397399        ELSE IF (Field(ind_b)%ndim==4) THEN 
    398400          DO i=1,FieldVarId(NbField)%size 
    399             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(i)) 
     401            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),  & 
     402                                  FieldVarId(NbField)%nc_id(i)) 
    400403            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat") 
    401404          ENDDO         
    … …  
    504507        ELSE IF (Field(ind_b)%ndim==4) THEN 
    505508          DO q=1,FieldVarId(NbField)%size 
    506             status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q)) 
     509            status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE,             & 
     510                                  (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q)) 
    507511            status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat") 
    508512          ENDDO         
Note: See TracChangeset for help on using the changeset viewer.