MODULE physics_lmdz_generic_mod USE field_mod USE transfert_mod INTEGER,SAVE :: nbp_phys TYPE(t_message) :: req_u TYPE(t_field),POINTER :: f_p(:) TYPE(t_field),POINTER :: f_pks(:) TYPE(t_field),POINTER :: f_pk(:) TYPE(t_field),POINTER :: f_p_layer(:) TYPE(t_field),POINTER :: f_theta(:) TYPE(t_field),POINTER :: f_phi(:) TYPE(t_field),POINTER :: f_Temp(:) TYPE(t_field),POINTER :: f_ulon(:) TYPE(t_field),POINTER :: f_ulat(:) TYPE(t_field),POINTER :: f_dulon(:) TYPE(t_field),POINTER :: f_dulat(:) TYPE(t_field),POINTER :: f_dTemp(:) TYPE(t_field),POINTER :: f_dq(:) TYPE(t_field),POINTER :: f_dps(:) TYPE(t_field),POINTER :: f_duc(:) INTEGER :: start_clock INTEGER :: stop_clock INTEGER :: count_clock=0 REAL :: start_day REAL :: day_length REAL :: year_length INTEGER,ALLOCATABLE,SAVE :: domain_offset(:) CONTAINS SUBROUTINE init_physics USE icosa USE domain_mod USE dimensions USE mpi_mod USE mpipara USE disvert_mod USE xios_mod IMPLICIT NONE INTEGER :: distrib(0:mpi_size-1) INTEGER :: ind,i,j,ij,pos REAL(rstd),ALLOCATABLE :: latfi(:) REAL(rstd),ALLOCATABLE :: lonfi(:) REAL(rstd),ALLOCATABLE :: airefi(:) REAL(rstd),ALLOCATABLE :: bounds_latfi(:,:) REAL(rstd),ALLOCATABLE :: bounds_lonfi(:,:) start_day=0 day_length=86400 year_length=86400*365.25 CALL getin('start_day',start_day) CALL getin('day_length',day_length) CALL getin('year_length',year_length) !$OMP PARALLEL CALL allocate_field(f_p,field_t,type_real,llm+1) CALL allocate_field(f_pks,field_t,type_real) CALL allocate_field(f_pk,field_t,type_real,llm) CALL allocate_field(f_p_layer,field_t,type_real,llm) CALL allocate_field(f_theta,field_t,type_real,llm) CALL allocate_field(f_phi,field_t,type_real,llm) CALL allocate_field(f_Temp,field_t,type_real,llm) CALL allocate_field(f_ulon,field_t,type_real,llm) CALL allocate_field(f_ulat,field_t,type_real,llm) CALL allocate_field(f_dulon,field_t,type_real,llm) CALL allocate_field(f_dulat,field_t,type_real,llm) CALL allocate_field(f_dTemp,field_t,type_real,llm) CALL allocate_field(f_dq,field_t,type_real,llm,nqtot) CALL allocate_field(f_dps,field_t,type_real) CALL allocate_field(f_duc,field_t,type_real,3,llm) !$OMP END PARALLEL ALLOCATE(domain_offset(ndomain)) nbp_phys=0 domain_offset(1)=0 DO ind=1,ndomain CALL swap_dimensions(ind) IF (ind implicit flush on phi(:,1) ! for other layers DO l = ll_beginp1, ll_end DO j=jj_begin,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i phi(ij,l) = 0.5 * ( theta(ij,l) + theta(ij,l-1) ) & * ( pk(ij,l-1) - pk(ij,l) ) ENDDO ENDDO ENDDO !$OMP BARRIER IF (is_omp_first_level) THEN DO l = 2, llm DO j=jj_begin,jj_end ! ---> Bug compilo intel ici en openmp ! ---> Couper la boucle IF (j==jj_end+1) PRINT*,"this message must not be printed" DO i=ii_begin,ii_end ij=(j-1)*iim+i phi(ij,l) = phi(ij,l)+ phi(ij,l-1) ENDDO ENDDO ENDDO ! --> IMPLICIT FLUSH on phi --> non ENDIF ! compute wind centered lon lat compound DO l=ll_begin,ll_end DO j=jj_begin,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i uc(:)=1/Ai(ij)* & ( ne(ij,right)*u(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:)) & + ne(ij,rup)*u(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:)) & + ne(ij,lup)*u(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:)) & + ne(ij,left)*u(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:)) & + ne(ij,ldown)*u(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))& + ne(ij,rdown)*u(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:))) ulon(ij,l)=sum(uc(:)*elon_i(ij,:)) ulat(ij,l)=sum(uc(:)*elat_i(ij,:)) ENDDO ENDDO ENDDO !$OMP BARRIER DO j=jj_begin,jj_end DO i=ii_begin,ii_end ij=(j-1)*iim+i offset=offset+1 IF (is_omp_first_level) ps_phy(offset) = ps(ij) p_phy(offset,ll_begin:ll_endp1) = p(ij,ll_begin:ll_endp1) p_layer_phy(offset,ll_begin:ll_end) = p_layer(ij,ll_begin:ll_end) Temp_phy(offset,ll_begin:ll_end) = Temp(ij,ll_begin:ll_end) IF (is_omp_first_level) phis_phy(offset) = phis(ij) phi_phy(offset,ll_begin:ll_end) = phi(ij,ll_begin:ll_end)-phis(ij) ulon_phy(offset,ll_begin:ll_end) = ulon(ij,ll_begin:ll_end) ulat_phy(offset,ll_begin:ll_end) = ulat(ij,ll_begin:ll_end) q_phy(offset,ll_begin:ll_end,:) = q(ij,ll_begin:ll_end,:) wflux_phy(offset,ll_begin:ll_end) = wflux(ij,ll_begin:ll_end) ENDDO ENDDO END SUBROUTINE grid_icosa_to_physics END SUBROUTINE physics END MODULE physics_lmdz_generic_mod