Changeset 726 for codes/icosagcm/devel/src
- Timestamp:
- 08/22/18 17:28:01 (6 years ago)
- Location:
- codes/icosagcm/devel/src
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/icosa_init.f90
r714 r726 55 55 CALL output_field_init 56 56 CALL init_timeloop 57 58 !$OMP END PARALLEL 59 57 60 CALL init_physics 58 61 62 !$OMP PARALLEL 63 59 64 CALL init_diagflux 60 65 CALL zero_du_phys -
codes/icosagcm/devel/src/initial/etat0_database.f90
r531 r726 57 57 CALL writeField("relief_out",f_phis,once=.TRUE.) 58 58 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 64 66 65 67 IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn",n_glo=nb_level) … … 98 100 ! make correction to ps due to relief at higher resolution 99 101 ! 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 104 109 CALL transfert_request(f_ps,req_i0) 105 110 CALL writeField("ps_out",f_ps) … … 135 140 ENDDO 136 141 142 CALL writeField("tempdb_out",f_temp_reg) 143 CALL writeField("temp_out",f_temp) 137 144 138 145 CALL deallocate_field(f_ts) -
codes/icosagcm/devel/src/output/xios_mod.F90
r551 r726 463 463 SUBROUTINE xios_read_var(name,field) 464 464 USE prec 465 USE transfert_mod 465 466 CHARACTER(LEN=*),INTENT(IN) :: name 466 467 REAL(rstd), INTENT(OUT) :: field 468 !$OMP MASTER 467 469 CALL xios_recv_field(name,field) 470 !$OMP END MASTER 471 CALL bcast_omp(field) 468 472 END SUBROUTINE 469 473 -
codes/icosagcm/devel/src/parallel/domain.f90
r533 r726 25 25 INTEGER,POINTER :: edge_assign_pos(:,:,:) 26 26 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(:,:,:) 27 31 REAL,POINTER :: xyz(:,:,:) 28 32 REAL,POINTER :: neighbour(:,:,:,:) … … 151 155 ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm)) 152 156 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)) 153 161 ALLOCATE(d%delta(d%iim,d%jjm)) 154 162 ALLOCATE(d%xyz(3,d%iim,d%jjm)) … … 193 201 d2%edge_assign_pos => d1%edge_assign_pos 194 202 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 195 207 d2%xyz => d1%xyz 196 208 d2%neighbour => d1%neighbour … … 231 243 USE metric 232 244 IMPLICIT NONE 233 INTEGER :: ind_d,ind,ind2,e 245 INTEGER :: ind_d,ind,ind2,e,v 234 246 INTEGER :: nf,nf2 235 247 INTEGER :: i,j,k,ii,jj … … 258 270 IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4) 259 271 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) 260 279 ENDDO 261 280 ENDDO … … 294 313 d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j) 295 314 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 296 321 297 322 ENDDO … … 318 343 edge_glo(e)%assign_delta=delta 319 344 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 321 361 322 END SUBROUTINE assign_cell323 324 362 SUBROUTINE compute_boundary 325 363 USE spherical_geom_mod -
codes/icosagcm/devel/src/parallel/mpipara.F90
r714 r726 57 57 IF (using_mpi) THEN 58 58 59 required_mode_str=' multiple'59 required_mode_str='funneled' 60 60 CALL getin('mpi_threading_mode',required_mode_str) 61 61 … … 81 81 IF (required_mode==MPI_THREAD_MULTIPLE) PRINT*,'MPI_INIT_THREAD : MPI_THREAD_MULTIPLE required' 82 82 83 84 CALL MPI_INIT_THREAD(MPI_THREAD_MULTIPLE,mpi_threading_mode,ierr) 83 CALL MPI_INIT_THREAD(required_mode,mpi_threading_mode,ierr) 85 84 86 85 IF (mpi_threading_mode==MPI_THREAD_SINGLE) PRINT*,'MPI_INIT_THREAD : MPI_SINGLE_THREAD provided' -
codes/icosagcm/devel/src/parallel/transfert.F90
r533 r726 3 3 #ifdef CPP_USING_MPI 4 4 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, & 6 6 create_request, gather_field, scatter_field, & 7 7 t_message, init_message=>init_message_mpi, & … … 12 12 #else 13 13 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, & 15 15 request_add_point, create_request, gather_field, & 16 16 scatter_field, t_message, & -
codes/icosagcm/devel/src/parallel/transfert_mpi.f90
r714 r726 49 49 TYPE(t_request),SAVE,POINTER :: req_e1_scal(:) 50 50 TYPE(t_request),SAVE,POINTER :: req_e1_vect(:) 51 TYPE(t_request),SAVE,POINTER :: req_z1_scal(:) 51 52 52 53 TYPE(t_request),SAVE,POINTER :: req_i0(:) … … 267 268 CALL finalize_request(req_e0_vect) 268 269 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) 269 300 270 301 END SUBROUTINE init_transfert … … 420 451 IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme' 421 452 422 src_domain=domain(ind)% assign_domain(i,j)453 src_domain=domain(ind)%vertex_assign_domain(pos-1,i,j) 423 454 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) 426 457 src_n=(src_j-1)*src_iim+src_i 427 458 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 430 461 431 462 req%target_ind(req%size)=(j-1)*d%iim+i+d%z_pos(pos) -
codes/icosagcm/devel/src/physics/physics.f90
r714 r726 39 39 SELECT CASE(TRIM(physics_type)) 40 40 CASE ('none') 41 42 !$OMP PARALLEL 41 43 IF(is_mpi_root) PRINT*,"NO PHYSICAL PACKAGE USED" 42 44 phys_type = phys_none 45 !$OMP END PARALLEL 46 43 47 CASE ('held_suarez') 48 49 !$OMP PARALLEL 44 50 phys_type = phys_HS94 51 !$OMP END PARALLEL 52 45 53 CASE ('Lebonnois2012') 54 55 !$OMP PARALLEL 46 56 phys_type = phys_LB2012 47 57 CALL init_phys_venus 58 !$OMP END PARALLEL 48 59 49 60 CASE ('phys_lmdz_generic') 61 62 !$OMP PARALLEL 50 63 CALL init_physics_lmdz_generic 51 64 phys_type=phys_lmdz_generic 65 !$OMP END PARALLEL 66 52 67 CASE ('phys_external') 68 53 69 CALL init_physics_external 70 !$OMP PARALLEL 54 71 phys_type=phys_external 72 !$OMP END PARALLEL 73 55 74 CASE ('dcmip') 75 76 !$OMP PARALLEL 56 77 CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon') 57 78 CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat') … … 65 86 CALL init_pack_after ! Defines Ai, lon, lat in physics_inout 66 87 phys_type = phys_DCMIP 88 !$OMP END PARALLEL 89 67 90 CASE ('dcmip2016') 91 92 !$OMP PARALLEL 68 93 CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon') 69 94 CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat') … … 77 102 CALL init_pack_after ! Defines Ai, lon, lat in physics_inout 78 103 phys_type = phys_DCMIP2016 104 !$OMP END PARALLEL 105 79 106 CASE DEFAULT 80 107 IF(is_mpi_root) PRINT*, 'init_physics : Bad selector for variable physics <',& … … 84 111 END SELECT 85 112 113 !$OMP PARALLEL 86 114 CALL allocate_field(f_du_phys,field_u,type_real,llm, name='du_phys') 87 115 88 116 IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type 117 !$OMP END PARALLEL 89 118 END SUBROUTINE init_physics 90 119 -
codes/icosagcm/devel/src/sphere/metric.f90
r533 r726 7 7 INTEGER :: neighbour(0:5) 8 8 INTEGER :: edge(0:5) 9 INTEGER :: vertex(0:5) 9 10 INTEGER :: assign_face 10 11 INTEGER :: assign_i … … 32 33 END TYPE t_edge_glo 33 34 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 34 42 35 43 TYPE(t_vertex_glo),ALLOCATABLE,SAVE :: vertex_glo(:,:,:) 36 44 TYPE(t_cell_glo),ALLOCATABLE,SAVE :: cell_glo(:) 37 45 TYPE(t_edge_glo),ALLOCATABLE,SAVE :: edge_glo(:) 46 TYPE(t_vertices_glo),ALLOCATABLE,SAVE :: vertices_glo(:) 38 47 INTEGER :: ncell_glo 39 48 … … 93 102 ALLOCATE(tab_index(nb_face,nb_face,0:5)) 94 103 ALLOCATE(edge_glo(ncell_glo*3)) 104 ALLOCATE(vertices_glo(ncell_glo*2)) 95 105 96 106 DO ind=1,ncell_glo … … 824 834 END SUBROUTINE set_cell_edge 825 835 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 826 885 SUBROUTINE set_vertex_edge 827 886 IMPLICIT NONE … … 850 909 ENDDO 851 910 ENDDO 911 912 852 913 END SUBROUTINE set_vertex_edge 853 914 … … 864 925 CALL compute_extended_face_bis 865 926 CALL set_cell_edge 927 CALL set_cell_vertex 866 928 CALL set_vertex_edge 867 929
Note: See TracChangeset
for help on using the changeset viewer.