Changeset 871


Ignore:
Timestamp:
05/17/19 15:02:07 (5 years ago)
Author:
ymipsl
Message:

experimental : add smooth physics tendency for external physics.

Activated with param :

phys_smooth_tendency=y

To be tested...

YM

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

Legend:

Unmodified
Added
Removed

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

    r713 r871  
    2020  CHARACTER(LEN=255),SAVE :: physics_type 
    2121!$OMP THREADPRIVATE(physics_type) 
     22  TYPE(t_message),SAVE :: req_theta0, req_ue0, req_q0 
    2223 
    2324  PUBLIC :: physics, init_physics, zero_du_phys 
    … …  
    115116 
    116117    IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type 
     118     
     119     
    117120!$OMP END PARALLEL 
    118121  END SUBROUTINE init_physics 
    … …  
    159162    TYPE(t_field),POINTER :: f_wflux(:) 
    160163    TYPE(t_field),POINTER :: f_q(:) 
    161  
     164     
     165    LOGICAL,SAVE :: first=.TRUE. 
     166!$OMP THREADPRIVATE(first) 
     167     
    162168    LOGICAL:: firstcall,lastcall 
    163169    INTEGER :: ind 
    164170    TYPE(t_physics_inout) :: args 
    165171 
    166     IF(MOD(it,itau_physics)==0 .AND. phys_type/=phys_none) THEN 
    167  
    168        ! as a result of the the two calls to add_du_phys, 
    169        ! du_phys increases by u(after physics) - u (before physics) 
    170        CALL add_du_phys(-1., f_ue) 
    171  
    172        SELECT CASE(phys_type) 
    173        CASE(phys_HS94) 
    174           CALL held_suarez(f_ps,f_theta_rhodz,f_ue)  
    175        CASE (phys_lmdz_generic) 
    176          CALL physics_lmdz_generic(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q) 
    177        CASE (phys_external) 
    178          CALL physics_external(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q) 
    179        CASE(phys_LB2012) 
    180           CALL phys_venus(f_ps,f_theta_rhodz,f_ue)  
    181        CASE DEFAULT 
    182           CALL physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
    183        END SELECT 
    184  
    185        CALL transfert_request(f_theta_rhodz,req_i0) 
    186        CALL transfert_request(f_ue,req_e0_vect) 
    187        CALL transfert_request(f_q,req_i0) 
    188  
    189        CALL add_du_phys(1., f_ue) 
    190     END IF 
    191  
    192     IF (mod(it,itau_out)==0 ) THEN 
    193        CALL write_physics_tendencies 
    194        CALL zero_du_phys 
    195        SELECT CASE(phys_type) 
    196        CASE (phys_DCMIP) 
    197           CALL write_physics_dcmip 
    198        CASE (phys_DCMIP2016) 
    199           CALL write_physics_dcmip2016 
    200        END SELECT 
    201     END IF 
     172    IF (first) THEN 
     173      CALL init_message(f_theta_rhodz, req_i0, req_theta0) 
     174      CALL init_message(f_ue, req_e0_vect, req_ue0) 
     175      CALL init_message(f_q, req_i0, req_q0) 
     176      first=.FALSE. 
     177    ENDIF 
     178 
     179 
     180    IF (phys_external) THEN 
     181     
     182      CALL physics_external(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q) 
     183 
     184    ELSE 
     185     
     186      IF(MOD(it,itau_physics)==0 .AND. phys_type/=phys_none) THEN 
     187 
     188         ! as a result of the the two calls to add_du_phys, 
     189         ! du_phys increases by u(after physics) - u (before physics) 
     190         CALL add_du_phys(-1., f_ue) 
     191 
     192         SELECT CASE(phys_type) 
     193         CASE(phys_HS94) 
     194            CALL held_suarez(f_ps,f_theta_rhodz,f_ue)  
     195         CASE (phys_lmdz_generic) 
     196           CALL physics_lmdz_generic(it ,f_phis, f_ps, f_theta_rhodz, f_ue, f_wflux, f_q) 
     197         CASE(phys_LB2012) 
     198            CALL phys_venus(f_ps,f_theta_rhodz,f_ue)  
     199         CASE DEFAULT 
     200            CALL physics_column(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
     201         END SELECT 
     202 
     203         CALL send_message(f_theta_rhodz, req_theta0) 
     204         CALL send_message(f_ue, req_ue0) 
     205         CALL send_message(f_q, req_q0) 
     206         CALL wait_message(req_theta0) 
     207         CALL wait_message(req_ue0) 
     208         CALL wait_message(req_q0) 
     209        
     210         CALL add_du_phys(1., f_ue) 
     211      END IF 
     212 
     213      IF (mod(it,itau_out)==0 ) THEN 
     214         CALL write_physics_tendencies 
     215         CALL zero_du_phys 
     216         SELECT CASE(phys_type) 
     217         CASE (phys_DCMIP) 
     218            CALL write_physics_dcmip 
     219         CASE (phys_DCMIP2016) 
     220            CALL write_physics_dcmip2016 
     221         END SELECT 
     222      END IF 
     223    ENDIF 
    202224     
    203225  END SUBROUTINE physics 

  • codes/icosagcm/trunk/src/physics/physics_external.F90

    r548 r871  
    1111  TYPE(t_field),POINTER,SAVE :: f_wflux(:) 
    1212  TYPE(t_field),POINTER,SAVE :: f_q(:) 
     13 
     14  TYPE(t_field),POINTER,SAVE :: f_theta_rhodz0(:) 
     15  TYPE(t_field),POINTER,SAVE :: f_u0(:) 
     16  TYPE(t_field),POINTER,SAVE :: f_q0(:) 
     17  
     18  TYPE(t_field),POINTER,SAVE :: f_dtheta_rhodz(:) 
     19  TYPE(t_field),POINTER,SAVE :: f_du(:) 
     20  TYPE(t_field),POINTER,SAVE :: f_dq(:) 
     21 
     22  TYPE(t_field),POINTER,SAVE :: f_rhodz(:) 
     23  TYPE(t_field),POINTER,SAVE :: f_rhodz0(:) 
    1324   
    14    
    15    
     25  LOGICAL,SAVE :: phys_smooth_tendency 
     26!$OMP THREADPRIVATE(phys_smooth_tendency)   
     27 
     28 
    1629CONTAINS 
    1730 
    1831  SUBROUTINE init_physics 
     32  USE icosa 
     33  IMPLICIT NONE 
    1934 
    2035    CALL initialize_external_physics 
     36    CALL allocate_field(f_theta_rhodz0, field_t, type_real, llm, nqdyn, name='theta_rhodz0') 
     37    CALL allocate_field(f_u0,field_u,type_real,llm,name='u0') 
     38    CALL allocate_field(f_q0,field_t,type_real,llm,nqtot,'q0') 
     39 
     40    CALL allocate_field(f_dtheta_rhodz, field_t, type_real, llm, nqdyn, name='theta_rhodz0') 
     41    CALL allocate_field(f_du,field_u,type_real,llm,name='u0') 
     42    CALL allocate_field(f_dq,field_t,type_real,llm,nqtot,'q0') 
     43 
     44    CALL allocate_field(f_rhodz, field_t, type_real, llm, name='rhodz') 
     45     
     46    phys_smooth_tendency=.FALSE. 
     47    CALL getin("phys_smooth_tendency",phys_smooth_tendency) 
     48     
    2149         
    2250  END SUBROUTINE init_physics 
    2351   
    2452  SUBROUTINE physics(it_,f_phis_, f_ps_, f_theta_rhodz_, f_u_, f_wflux_, f_q_) 
     53  USE icosa 
    2554  USE field_mod 
     55  USE mpipara 
     56  USE omp_para 
     57  USE xios 
     58  USE domain_mod 
     59  USE time_mod 
     60  USE disvert_mod 
    2661  IMPLICIT NONE 
    2762    INTEGER,INTENT(IN)    :: it_ 
    … …  
    3368    TYPE(t_field),POINTER :: f_q_(:) 
    3469 
    35     it=it_ 
     70    REAL(rstd),POINTER    :: theta_rhodz(:,:,:), theta_rhodz0(:,:,:), dtheta_rhodz(:,:,:)  
     71    REAL(rstd),POINTER    :: u(:,:), u0(:,:), du(:,:) 
     72    REAL(rstd),POINTER    :: q(:,:,:),q0(:,:,:),dq(:,:,:) 
     73    REAL(rstd),POINTER    :: ps(:) 
     74    REAL(rstd),POINTER    :: rhodz(:,:) 
     75    INTEGER :: ind, iq 
     76     
    3677     
    3778!$OMP BARRIER 
    … …  
    4687!$OMP BARRIER 
    4788 
    48     CALL external_physics 
     89    IF (phys_smooth_tendency) THEN 
    4990     
     91      IF (MOD(it_,itau_physics)==1) THEN 
     92        DO ind=1, ndomain 
     93          IF (.NOT. assigned_domain(ind)) CYCLE 
     94          CALL swap_dimensions(ind) 
     95          CALL swap_geometry(ind) 
     96          theta_rhodz=f_theta_rhodz(ind) 
     97          theta_rhodz0=f_theta_rhodz0(ind) 
     98          u=f_u(ind) 
     99          u0=f_u0(ind) 
     100          q=f_q(ind) 
     101          q0=f_q0(ind) 
     102          ps=f_ps(ind) 
     103          rhodz=f_rhodz(ind) 
     104        
     105          theta_rhodz0(:,:,1)=theta_rhodz(:,:,1) 
     106          u0=u 
     107          q0=q 
     108          CALL compute_rhodz(.TRUE., ps, rhodz) 
     109        ENDDO 
     110      
     111        IF (is_omp_master) CALL xios_timer_suspend("dynamico") 
     112        it = it_-1 + itau_physics 
     113        CALL external_physics 
     114        IF (is_omp_master) CALL xios_timer_resume("dynamico") 
     115 
     116        DO ind=1, ndomain 
     117          IF (.NOT. assigned_domain(ind)) CYCLE 
     118          CALL swap_dimensions(ind)  
     119          CALL swap_geometry(ind)  
     120          theta_rhodz=f_theta_rhodz(ind) 
     121          theta_rhodz0=f_theta_rhodz0(ind) 
     122          u=f_u(ind) 
     123          u0=f_u0(ind) 
     124          q=f_q(ind) 
     125          q0=f_q0(ind) 
     126          dtheta_rhodz=f_dtheta_rhodz(ind) 
     127          du=f_du(ind) 
     128          dq=f_dq(ind) 
     129          rhodz=f_rhodz(ind) 
     130        
     131          dtheta_rhodz(:,:,1)=(theta_rhodz(:,:,1)-theta_rhodz0(:,:,1))/itau_physics 
     132          du=(u-u0)/itau_physics 
     133    
     134          DO iq=1, nqtot 
     135            dq(:,:,iq)=((q(:,:,iq)-q0(:,:,iq))/itau_physics)/rhodz(:,:) 
     136          ENDDO 
     137          
     138          theta_rhodz(:,:,1)=theta_rhodz0(:,:,1) 
     139          u=u0 
     140          q=q0 
     141        ENDDO 
     142     ENDIF 
     143    
     144     DO ind=1, ndomain 
     145       IF (.NOT. assigned_domain(ind)) CYCLE 
     146       CALL swap_dimensions(ind) 
     147       CALL swap_geometry(ind) 
     148          
     149       theta_rhodz=f_theta_rhodz(ind) 
     150       u=f_u(ind) 
     151       q=f_q(ind) 
     152       dtheta_rhodz=f_dtheta_rhodz(ind) 
     153       du=f_du(ind) 
     154       dq=f_dq(ind) 
     155       rhodz=f_rhodz(ind) 
     156       ps=f_ps(ind) 
     157 
     158       u=u+du 
     159       theta_rhodz=theta_rhodz+dtheta_rhodz 
     160       CALL compute_rhodz(.TRUE., ps, rhodz) 
     161       DO iq=1, nqtot 
     162         q(:,:,iq)=q(:,:,iq)+dq(:,:,iq)*rhodz(:,:) 
     163       ENDDO 
     164     ENDDO 
     165    
     166   ELSE 
     167        
     168     IF (MOD(it_,itau_physics)==0) THEN 
     169       it=it_ 
     170       IF (is_omp_master) CALL xios_timer_suspend("dynamico") 
     171       CALL external_physics 
     172       IF (is_omp_master) CALL xios_timer_resume("dynamico") 
     173     ENDIF 
     174    
     175   ENDIF       
     176 
     177 
    50178  END SUBROUTINE physics 
    51179   

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

    r667 r871  
    345345        
    346346       CALL enter_profile(id_diags) 
    347        IF (MOD(it,itau_physics)==0) THEN 
     347!       IF (MOD(it,itau_physics)==0) THEN 
    348348          CALL check_conserve_detailed(it, AAM_dyn, & 
    349349            f_ps,f_dps,f_u,f_theta_rhodz,f_phis) 
    … …  
    357357          !$OMP END MASTER    
    358358          first_physic=.FALSE. 
    359        END IF 
     359!       END IF 
    360360 
    361361       IF (MOD(it,itau_check_conserv)==0) THEN 
Note: See TracChangeset for help on using the changeset viewer.