Changeset 214 for codes/icosagcm/trunk
- Timestamp:
- 07/15/14 18:23:54 (10 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/physics.f90
r213 r214 23 23 USE icosa 24 24 USE physics_interface_mod 25 USE physics_dcmip_mod, ONLY : & 26 init_physics_dcmip=>init_physics, init_physics_dcmip_new=>init_physics_new 25 USE physics_dcmip_mod, ONLY : init_physics_dcmip_new=>init_physics 27 26 IMPLICIT NONE 28 27 … … 47 46 48 47 CASE ('dcmip') 49 CALL init_physics_dcmip_new 50 ! CALL init_physics_dcmip 48 CALL init_physics_dcmip 51 49 phys_type = phys_DCMIP 52 50 CASE DEFAULT … … 56 54 END SELECT 57 55 58 IF(is_mpi_root) THEN 59 PRINT *, 'phys_type = ',phys_type 60 PRINT *, 'nb_extra_physics_2D = ', nb_extra_physics_2D 61 PRINT *, 'nb_extra_physics_3D = ', nb_extra_physics_3D 62 END IF 63 64 IF(.FALSE.) THEN ! draft interface 65 IF(nb_extra_physics_2D>0) CALL allocate_field(f_extra_physics_2D,field_t,type_real,nb_extra_physics_2D) 66 IF(nb_extra_physics_3D>0) CALL allocate_field(f_extra_physics_3D,field_t,type_real,llm,nb_extra_physics_3D) 67 ELSE 68 CALL init_pack_after ! Defines Ai, lon, lat in physics_inout 69 END IF 56 IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type 57 physics_inout%dt_phys = dt*itau_physics 58 CALL init_pack_after ! Defines Ai, lon, lat in physics_inout 70 59 END SUBROUTINE init_physics 71 60 … … 101 90 CALL held_suarez(f_ps,f_theta_rhodz,f_ue) 102 91 CASE DEFAULT 103 IF(.FALSE.) THEN ! draft interface 104 args%dt_phys = dt*itau_physics 105 DO ind=1,ndomain 106 IF (.NOT. assigned_domain(ind)) CYCLE 107 CALL swap_dimensions(ind) 108 CALL swap_geometry(ind) 109 110 phis=f_phis(ind) 111 ps=f_ps(ind) 112 theta_rhodz=f_theta_rhodz(ind) 113 ue=f_ue(ind) 114 q=f_q(ind) 115 116 IF(nb_extra_physics_2D>0) args%extra_2D=f_extra_physics_2D(ind) 117 IF(nb_extra_physics_3D>0) args%extra_3D=f_extra_physics_3D(ind) 118 CALL physics_column(args, phis, ps, theta_rhodz, ue, q) 119 ENDDO 120 121 IF (mod(it,itau_out)==0 ) THEN 122 IF(nb_extra_physics_2D>0) CALL writefield("extra_physics_2D",f_extra_physics_2D) 123 IF(nb_extra_physics_3D>0) CALL writefield("extra_physics_3D",f_extra_physics_3D) 124 ENDIF 125 ELSE ! new interface 126 physics_inout%dt_phys = dt*itau_physics 127 CALL physics_column_new(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 128 END IF 92 CALL physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 129 93 END SELECT 130 94 … … 143 107 END SUBROUTINE physics 144 108 145 !--------------------------------- New interface -------------------------------------- 146 147 SUBROUTINE physics_column_new(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 109 SUBROUTINE physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 148 110 USE icosa 149 111 USE physics_interface_mod … … 207 169 END DO 208 170 209 END SUBROUTINE physics_column _new171 END SUBROUTINE physics_column 210 172 211 173 SUBROUTINE pack_physics(info, phis, ps, theta_rhodz, ue, q) … … 298 260 END SUBROUTINE compute_update_velocity 299 261 300 !--------------------------------- Draft interface --------------------------------------301 302 SUBROUTINE physics_column(args, phis, ps, theta_rhodz, ue, q)303 USE icosa304 USE wind_mod305 USE pression_mod306 USE theta2theta_rhodz_mod307 USE physics_interface_mod308 USE physics_dcmip_mod309 IMPLICIT NONE310 TYPE(t_physics_inout) :: args311 REAL(rstd) :: phis(iim*jjm)312 REAL(rstd) :: ps(iim*jjm)313 REAL(rstd) :: theta_rhodz(iim*jjm,llm)314 REAL(rstd) :: ue(3*iim*jjm,llm)315 REAL(rstd), TARGET :: q(iim*jjm,llm,nqtot)316 ! local arrays317 REAL(rstd), TARGET :: lat(iim*jjm)318 REAL(rstd), TARGET :: lon(iim*jjm)319 REAL(rstd), TARGET :: p(iim*jjm,llm+1)320 REAL(rstd), TARGET :: Temp(iim*jjm,llm)321 REAL(rstd), TARGET :: ulon(iim*jjm,llm)322 REAL(rstd), TARGET :: ulat(iim*jjm,llm)323 REAL(rstd), TARGET :: dTemp(iim*jjm,llm)324 REAL(rstd), TARGET :: dulon(iim*jjm,llm)325 REAL(rstd), TARGET :: dulat(iim*jjm,llm)326 REAL(rstd), TARGET :: dq(iim*jjm,llm,nqtot)327 REAL(rstd) :: uc(iim*jjm,3,llm) ! 3D velocity at cell centers328 329 INTEGER :: i,j,ij,l330 REAL(rstd) :: due, dt2331 332 DO j=jj_begin,jj_end333 DO i=ii_begin,ii_end334 ij=(j-1)*iim+i335 CALL xyz2lonlat(xyz_i(ij,:),lon(ij),lat(ij))336 ENDDO337 ENDDO338 339 ! Reconstruct wind vector at hexagons340 CALL compute_pression(ps,p,0)341 CALL compute_theta_rhodz2temperature(ps,theta_rhodz,Temp,0)342 CALL compute_wind_centered(ue,uc)343 CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)344 args%ngrid = iim*jjm345 args%lon => lon346 args%lat => lat347 args%p => p348 args%Temp => Temp349 args%ulon => ulon350 args%ulat => ulat351 args%q => q352 args%dTemp => dTemp353 args%dulon => dulon354 args%dulat => dulat355 args%dq => dq356 357 SELECT CASE(phys_type)358 CASE (phys_DCMIP)359 CALL compute_phys_wrap(args)360 END SELECT361 362 q = q + args%dt_phys * dq363 Temp = Temp + args%dt_phys * dTemp364 CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)365 366 ! Reconstruct wind tendencies at edges and add367 CALL compute_wind_centered_from_lonlat_compound(dulon,dulat,uc)368 dt2=.5*args%dt_phys369 DO l=1,llm370 DO j=jj_begin,jj_end371 DO i=ii_begin,ii_end372 ij=(j-1)*iim+i373 due = sum( (uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:) )374 ue(ij+u_right,l) = ue(ij+u_right,l) + dt2*due375 376 due = sum( (uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )377 ue(ij+u_lup,l)=ue(ij+u_lup,l) + dt2*due378 379 due = sum( (uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )380 ue(ij+u_ldown,l)=ue(ij+u_ldown,l) + dt2*due381 ENDDO382 ENDDO383 ENDDO384 385 END SUBROUTINE physics_column386 387 262 END MODULE physics_mod -
codes/icosagcm/trunk/src/physics_dcmip.f90
r213 r214 12 12 REAL(rstd),ALLOCATABLE :: precl_packed(:) 13 13 14 PUBLIC :: compute_phys_wrap, init_physics, & 15 init_physics_new, full_physics, write_physics 14 PUBLIC :: init_physics, full_physics, write_physics 16 15 17 16 CONTAINS 18 17 19 !-------------------------- New interface ---------------------- 20 21 SUBROUTINE init_physics_new 18 SUBROUTINE init_physics 22 19 USE physics_interface_mod 23 20 IMPLICIT NONE … … 63 60 CALL output_field("precl",f_precl) 64 61 END SUBROUTINE write_physics 65 66 !------------------------ Draft interface -----------------------67 68 SUBROUTINE init_physics69 USE physics_interface_mod70 IMPLICIT NONE71 testcase=1 ! OK for 4.2 (moist baroclinic instability)72 CALL getin("dcmip_physics",testcase)73 nb_extra_physics_2D=1 ! precl74 nb_extra_physics_3D=075 END SUBROUTINE init_physics76 77 SUBROUTINE compute_phys_wrap(args)78 USE physics_interface_mod79 TYPE(t_physics_inout) :: args80 CALL compute_physics(args%ngrid, args%dt_phys, args%lat, &81 args%p, args%Temp, args%ulon, args%ulat, args%q(:,:,1), &82 args%dTemp, args%dulon, args%dulat, args%dq(:,:,1), args%extra_2D(:,1))83 END SUBROUTINE compute_phys_wrap84 85 !------------------ Interface-independent wrapper ---------------------------86 62 87 63 SUBROUTINE compute_physics(ngrid,dt_phys,lat, p,Temp,u,v,q, dTemp,du,dv,dq, precl) -
codes/icosagcm/trunk/src/physics_interface.f90
r213 r214 4 4 5 5 PRIVATE 6 7 INTEGER :: nb_extra_physics_2D, nb_extra_physics_3D8 6 9 7 TYPE t_physics_inout … … 18 16 REAL(rstd), DIMENSION(:,:), POINTER :: dTemp, dulon, dulat 19 17 REAL(rstd), DIMENSION(:,:,:), POINTER :: dq 20 ! extra output arrays (physics diagnostics)21 REAL(rstd), DIMENSION(:,:), POINTER :: extra_2D22 REAL(rstd), DIMENSION(:,:,:), POINTER :: extra_3D23 18 END TYPE t_physics_inout 24 19 25 !------------------------ (new interface) --------------------------26 20 ! physics_inout is used to exchange information with physics 27 21 ! Field ngrid is initialized by physics.f90/init_physics. Its other fields … … 33 27 TYPE(t_physics_inout), SAVE :: physics_inout 34 28 35 !------------------------ (new interface) --------------------------36 29 ! pack_info contains indices used by pack/unpack routines 37 30 ! to pack together the data of all the domains managed by the MPI process 38 31 ! It is initialized by physics.f90/init_physics 32 39 33 TYPE t_pack_info 40 34 INTEGER :: ngrid, & ! number of non-halo points in that domain
Note: See TracChangeset
for help on using the changeset viewer.