Changeset 214


Ignore:
Timestamp:
07/15/14 18:23:54 (10 years ago)
Author:
dubos
Message:

New dyn/phys interface - halo points not passed to physics any more (cleanup follows)

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

Legend:

Unmodified
Added
Removed

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

    r213 r214  
    2323    USE icosa 
    2424    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 
    2726    IMPLICIT NONE 
    2827 
    … …  
    4746 
    4847    CASE ('dcmip') 
    49        CALL init_physics_dcmip_new 
    50 !       CALL init_physics_dcmip 
     48       CALL init_physics_dcmip 
    5149       phys_type = phys_DCMIP 
    5250    CASE DEFAULT 
    … …  
    5654    END SELECT 
    5755 
    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 
    7059  END SUBROUTINE init_physics 
    7160 
    … …  
    10190          CALL held_suarez(f_ps,f_theta_rhodz,f_ue)  
    10291       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) 
    12993       END SELECT 
    13094 
    … …  
    143107  END SUBROUTINE physics 
    144108 
    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) 
    148110    USE icosa 
    149111    USE physics_interface_mod 
    … …  
    207169    END DO 
    208170 
    209   END SUBROUTINE physics_column_new 
     171  END SUBROUTINE physics_column 
    210172 
    211173  SUBROUTINE pack_physics(info, phis, ps, theta_rhodz, ue, q) 
    … …  
    298260  END SUBROUTINE compute_update_velocity 
    299261 
    300 !--------------------------------- Draft interface -------------------------------------- 
    301  
    302   SUBROUTINE physics_column(args, phis, ps, theta_rhodz, ue, q) 
    303     USE icosa 
    304     USE wind_mod 
    305     USE pression_mod 
    306     USE theta2theta_rhodz_mod 
    307     USE physics_interface_mod 
    308     USE physics_dcmip_mod 
    309     IMPLICIT NONE 
    310     TYPE(t_physics_inout) :: args     
    311     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 arrays 
    317     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 centers 
    328  
    329     INTEGER :: i,j,ij,l 
    330     REAL(rstd) :: due, dt2 
    331  
    332     DO j=jj_begin,jj_end 
    333       DO i=ii_begin,ii_end 
    334         ij=(j-1)*iim+i 
    335         CALL xyz2lonlat(xyz_i(ij,:),lon(ij),lat(ij))  
    336       ENDDO 
    337     ENDDO 
    338  
    339     ! Reconstruct wind vector at hexagons 
    340     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*jjm 
    345     args%lon => lon 
    346     args%lat => lat 
    347     args%p => p 
    348     args%Temp => Temp 
    349     args%ulon => ulon 
    350     args%ulat => ulat 
    351     args%q => q 
    352     args%dTemp => dTemp 
    353     args%dulon => dulon 
    354     args%dulat => dulat 
    355     args%dq => dq 
    356  
    357     SELECT CASE(phys_type) 
    358     CASE (phys_DCMIP) 
    359        CALL compute_phys_wrap(args) 
    360     END SELECT 
    361  
    362     q = q + args%dt_phys * dq 
    363     Temp = Temp + args%dt_phys * dTemp 
    364     CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0) 
    365      
    366     ! Reconstruct wind tendencies at edges and add 
    367     CALL compute_wind_centered_from_lonlat_compound(dulon,dulat,uc) 
    368     dt2=.5*args%dt_phys 
    369     DO l=1,llm 
    370       DO j=jj_begin,jj_end 
    371         DO i=ii_begin,ii_end 
    372           ij=(j-1)*iim+i 
    373           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*due 
    375  
    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*due 
    378  
    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*due 
    381         ENDDO 
    382       ENDDO 
    383     ENDDO 
    384  
    385   END SUBROUTINE physics_column 
    386  
    387262END MODULE physics_mod 

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

    r213 r214  
    1212  REAL(rstd),ALLOCATABLE :: precl_packed(:) 
    1313 
    14   PUBLIC :: compute_phys_wrap, init_physics, & 
    15        init_physics_new, full_physics, write_physics 
     14  PUBLIC :: init_physics, full_physics, write_physics 
    1615 
    1716CONTAINS 
    1817 
    19 !-------------------------- New interface ---------------------- 
    20  
    21   SUBROUTINE init_physics_new 
     18  SUBROUTINE init_physics 
    2219    USE physics_interface_mod 
    2320    IMPLICIT NONE 
    … …  
    6360    CALL output_field("precl",f_precl) 
    6461  END SUBROUTINE write_physics 
    65  
    66 !------------------------ Draft interface ----------------------- 
    67  
    68   SUBROUTINE init_physics 
    69     USE physics_interface_mod 
    70     IMPLICIT NONE 
    71     testcase=1 ! OK for 4.2 (moist baroclinic instability) 
    72     CALL getin("dcmip_physics",testcase) 
    73     nb_extra_physics_2D=1 ! precl 
    74     nb_extra_physics_3D=0 
    75   END SUBROUTINE init_physics 
    76  
    77   SUBROUTINE compute_phys_wrap(args) 
    78     USE physics_interface_mod 
    79     TYPE(t_physics_inout) :: args 
    80     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_wrap 
    84  
    85 !------------------ Interface-independent wrapper --------------------------- 
    8662 
    8763  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  
    44 
    55  PRIVATE 
    6  
    7   INTEGER :: nb_extra_physics_2D, nb_extra_physics_3D 
    86 
    97  TYPE t_physics_inout 
    … …  
    1816     REAL(rstd), DIMENSION(:,:), POINTER :: dTemp, dulon, dulat 
    1917     REAL(rstd), DIMENSION(:,:,:), POINTER :: dq 
    20      ! extra output arrays (physics diagnostics) 
    21      REAL(rstd), DIMENSION(:,:), POINTER :: extra_2D 
    22      REAL(rstd), DIMENSION(:,:,:), POINTER :: extra_3D 
    2318  END TYPE t_physics_inout 
    2419 
    25 !------------------------ (new interface) -------------------------- 
    2620! physics_inout is used to exchange information with physics 
    2721! Field ngrid is initialized by physics.f90/init_physics. Its other fields 
    … …  
    3327  TYPE(t_physics_inout), SAVE :: physics_inout 
    3428  
    35 !------------------------ (new interface) -------------------------- 
    3629! pack_info contains indices used by pack/unpack routines 
    3730! to pack together the data of all the domains managed by the MPI process 
    3831! It is initialized by physics.f90/init_physics  
     32 
    3933  TYPE t_pack_info 
    4034     INTEGER :: ngrid, & ! number of non-halo points in that domain 
Note: See TracChangeset for help on using the changeset viewer.