Ignore:
Timestamp:
Jul 25, 2024, 5:47:25 PM (11 months ago)
Author:
abarral
Message:

Correct bug in vlspltqs_loc.f90 from r2270 where we call SSUM with incorrect arguments.
Merge the three different versions of abort_gcm into one
Fix seq, para 3D compilation broken from r5107 onwards
(lint) usual + Remove uneeded fixed-form continuations

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h

    r5117 r5128  
    190190
    191191        common /turb_forcing/                                                   &
    192      &  dtime_frcg,hthturb_gcssold, hqturb_gcssold,Turb_fcg_gcssold
     192        dtime_frcg,hthturb_gcssold, hqturb_gcssold,Turb_fcg_gcssold
    193193!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    194194! Declarations specifiques au cas Arm_cu

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h

    r5117 r5128  
    99        CALL interp_case_time_std(daytime,day1,annee_ref                                       &
    1010!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
    11      &       ,nt_cas,nlev_cas                                                               &
    12      &       ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
    13      &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
    14      &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
    15      &       ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas    &
    16      &       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                                       &
    17      &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
    18      &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    19      &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
     11             ,nt_cas,nlev_cas                                                               &
     12             ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
     13             ,u_cas,v_cas,ug_cas,vg_cas                                                     &
     14             ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
     15             ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas    &
     16             ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                                       &
     17             ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
     18             ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
     19             ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    2020
    21      &       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    22      &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    23      &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
    24      &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
    25      &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas  &     
    26      &       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                     &
    27      &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
    28      &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
    29      &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
    30      &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
    31      &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
     21             ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
     22             ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
     23             ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
     24             ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
     25             ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas  &
     26             ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                     &
     27             ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
     28             ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
     29             ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
     30             ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
     31             ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
    3232! EV tg instead of ts_cur
    3333             tg = ts_prof_cas
    … …  
    4141! vertical interpolation:
    4242      CALL interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                                              &
    43      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                       &
    44      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
    45      &         ,ug_prof_cas,vg_prof_cas                                                                   &
    46      &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                       &
    47      &         ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
     43               ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                       &
     44               ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
     45               ,ug_prof_cas,vg_prof_cas                                                                   &
     46               ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                       &
     47               ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
    4848
    49      &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
    50      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
    51      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
    52      &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
     49               ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
     50               ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
     51               ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
     52               ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
    5353
    54      &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
    55      &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
    56      &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
    57      &         ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas   &     
    58      &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
    59      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
    60      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
    61      &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
     54               ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
     55               ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
     56               ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
     57               ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas   &
     58               ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
     59               ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
     60               ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
     61               ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
    6262
    6363

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h

    r5117 r5128  
    2222        CALL interp_case_time_std(daytime,day1,annee_ref                                       &
    2323!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
    24      &       ,nt_cas,nlev_cas                                                               &
    25      &       ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
    26      &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
    27      &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
    28      &       ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas    &
    29      &       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                               &
    30      &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
    31      &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    32      &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
     24             ,nt_cas,nlev_cas                                                               &
     25             ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
     26             ,u_cas,v_cas,ug_cas,vg_cas                                                     &
     27             ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
     28             ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas    &
     29             ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                               &
     30             ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
     31             ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
     32             ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    3333
    34      &       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    35      &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    36      &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
    37      &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
    38      &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
    39      &       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                    &
    40      &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
    41      &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
    42      &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
    43      &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
    44      &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
     34             ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
     35             ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
     36             ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
     37             ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
     38             ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
     39             ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                    &
     40             ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
     41             ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
     42             ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
     43             ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
     44             ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
    4545
    4646      do l = 1, nlev_cas
    … …  
    5151!      WRITE(*,*)'avant interp vert', t_prof
    5252      CALL interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                                              &
    53      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
    54      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
    55      &         ,ug_prof_cas,vg_prof_cas                                                                   &
    56      &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                         &
    57      &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas       &
    58      &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
    59      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
    60      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
    61      &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
     53               ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
     54               ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
     55               ,ug_prof_cas,vg_prof_cas                                                                   &
     56             ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                         &
     57             ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas       &
     58               ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
     59               ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
     60               ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
     61               ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
    6262
    63      &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
    64      &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
    65      &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
    66      &         ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas        &
    67      &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
    68      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
    69      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
    70      &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
     63               ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
     64               ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
     65               ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
     66               ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas        &
     67               ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
     68               ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
     69               ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
     70               ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
    7171
    7272

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h

    r5117 r5128  
    4646      real    :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
    4747      common/com_par1d/                                                 &
    48      & nat_surf,tsurf,beta_surf,rugos,rugosh,                           &
    49      & xqsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,   &
    50      & wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
    51      & forcing_type,tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo,       &
    52      & nudge_u,nudge_v,nudge_w,nudge_t,nudge_q,                         &
    53      & iflag_nudge,snowmass,                                            &
    54      & restart,ok_old_disvert,                                          &
    55      & tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh,   &
    56      & trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar,  &
    57      & nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w,          &
    58      & p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w
     48       nat_surf,tsurf,beta_surf,rugos,rugosh,                           &
     49       xqsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,   &
     50       wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
     51       forcing_type,tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo,       &
     52       nudge_u,nudge_v,nudge_w,nudge_t,nudge_q,                         &
     53       iflag_nudge,snowmass,                                            &
     54       restart,ok_old_disvert,                                          &
     55       tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh,   &
     56       trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar,  &
     57       nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w,          &
     58       p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w
    5959
    6060!$OMP THREADPRIVATE(/com_par1d/)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90

    r5119 r5128  
    11MODULE lmdz_1dutils
    22  IMPLICIT NONE; PRIVATE
    3   PUBLIC fq_sat, conf_unicol, dyn1deta0, dyn1dredem, gr_fi_dyn, abort_gcm, gr_dyn_fi, &
     3  PUBLIC fq_sat, conf_unicol, dyn1deta0, dyn1dredem, &
    44          disvert0, advect_vert, advect_va, lstendh, nudge_rht_init, nudge_uv_init, &
    55          nudge_rht, nudge_uv, interp2_case_vertical
    … …  
    981981
    982982
    983   SUBROUTINE gr_fi_dyn(nfield, ngrid, im, jm, pfi, pdyn)
    984     USE lmdz_ssum_scopy, ONLY: scopy
    985 
    986     IMPLICIT NONE
    987     !=======================================================================
    988     !   passage d'un champ de la grille scalaire a la grille physique
    989     !=======================================================================
    990 
    991     !-----------------------------------------------------------------------
    992     !   declarations:
    993     !   -------------
    994 
    995     INTEGER im, jm, ngrid, nfield
    996     REAL pdyn(im, jm, nfield)
    997     REAL pfi(ngrid, nfield)
    998 
    999     INTEGER i, j, ifield, ig
    1000 
    1001     !-----------------------------------------------------------------------
    1002     !   calcul:
    1003     !   -------
    1004 
    1005     DO ifield = 1, nfield
    1006       !   traitement des poles
    1007       DO i = 1, im
    1008         pdyn(i, 1, ifield) = pfi(1, ifield)
    1009         pdyn(i, jm, ifield) = pfi(ngrid, ifield)
    1010       ENDDO
    1011 
    1012       !   traitement des point normaux
    1013       DO j = 2, jm - 1
    1014         ig = 2 + (j - 2) * (im - 1)
    1015         CALL SCOPY(im - 1, pfi(ig, ifield), 1, pdyn(1, j, ifield), 1)
    1016         pdyn(im, j, ifield) = pdyn(1, j, ifield)
    1017       ENDDO
    1018     ENDDO
    1019 
    1020   END SUBROUTINE gr_fi_dyn
    1021 
    1022 
    1023   SUBROUTINE abort_gcm(modname, message, ierr)
    1024     USE IOIPSL
    1025 
    1026     ! Stops the simulation cleanly, closing files and printing various
    1027     ! comments
    1028 
    1029     !  Input: modname = name of calling program
    1030     !         message = stuff to print
    1031     !         ierr    = severity of situation ( = 0 normal )
    1032 
    1033     CHARACTER(LEN = *) modname
    1034     INTEGER ierr
    1035     CHARACTER(LEN = *) message
    1036 
    1037     WRITE(*, *) 'in abort_gcm'
    1038     CALL histclo
    1039     !     CALL histclo(2)
    1040     !     CALL histclo(3)
    1041     !     CALL histclo(4)
    1042     !     CALL histclo(5)
    1043     WRITE(*, *) 'out of histclo'
    1044     WRITE(*, *) 'Stopping in ', modname
    1045     WRITE(*, *) 'Reason = ', message
    1046     CALL getin_dump
    1047 
    1048     IF (ierr == 0) THEN
    1049       WRITE(*, *) 'Everything is cool'
    1050     else
    1051       WRITE(*, *) 'Houston, we have a problem ', ierr
    1052     endif
    1053     STOP
    1054   END SUBROUTINE abort_gcm
    1055 
    1056 
    1057   SUBROUTINE gr_dyn_fi(nfield, im, jm, ngrid, pdyn, pfi)
    1058     IMPLICIT NONE
    1059     !=======================================================================
    1060     !   passage d'un champ de la grille scalaire a la grille physique
    1061     !=======================================================================
    1062 
    1063     !-----------------------------------------------------------------------
    1064     !   declarations:
    1065     !   -------------
    1066 
    1067     INTEGER im, jm, ngrid, nfield
    1068     REAL pdyn(im, jm, nfield)
    1069     REAL pfi(ngrid, nfield)
    1070 
    1071     INTEGER j, ifield, ig
    1072 
    1073     !-----------------------------------------------------------------------
    1074     !   calcul:
    1075     !   -------
    1076 
    1077     IF(ngrid/=2 + (jm - 2) * (im - 1).AND.ngrid/=1)                          &
    1078             &    STOP 'probleme de dim'
    1079     !   traitement des poles
    1080     CALL SCOPY(nfield, pdyn, im * jm, pfi, ngrid)
    1081     CALL SCOPY(nfield, pdyn(1, jm, 1), im * jm, pfi(ngrid, 1), ngrid)
    1082 
    1083     !   traitement des point normaux
    1084     DO ifield = 1, nfield
    1085       DO j = 2, jm - 1
    1086         ig = 2 + (j - 2) * (im - 1)
    1087         CALL SCOPY(im - 1, pdyn(1, j, ifield), 1, pfi(ig, ifield), 1)
    1088       ENDDO
    1089     ENDDO
    1090   END SUBROUTINE gr_dyn_fi
    1091 
    1092 
    1093983  SUBROUTINE disvert0(pa, preff, ap, bp, dpres, presnivs, nivsigs, nivsig)
    1094984
    … …  
    18521742
    18531743END MODULE lmdz_1dutils
     1744
     1745SUBROUTINE gr_fi_dyn(nfield, ngrid, im, jm, pfi, pdyn)
     1746  USE lmdz_ssum_scopy, ONLY: scopy
     1747
     1748  IMPLICIT NONE
     1749  !=======================================================================
     1750  !   passage d'un champ de la grille scalaire a la grille physique
     1751  !=======================================================================
     1752
     1753  !-----------------------------------------------------------------------
     1754  !   declarations:
     1755  !   -------------
     1756
     1757  INTEGER im, jm, ngrid, nfield
     1758  REAL pdyn(im, jm, nfield)
     1759  REAL pfi(ngrid, nfield)
     1760
     1761  INTEGER i, j, ifield, ig
     1762
     1763  !-----------------------------------------------------------------------
     1764  !   calcul:
     1765  !   -------
     1766
     1767  DO ifield = 1, nfield
     1768    !   traitement des poles
     1769    DO i = 1, im
     1770      pdyn(i, 1, ifield) = pfi(1, ifield)
     1771      pdyn(i, jm, ifield) = pfi(ngrid, ifield)
     1772    ENDDO
     1773
     1774    !   traitement des point normaux
     1775    DO j = 2, jm - 1
     1776      ig = 2 + (j - 2) * (im - 1)
     1777      CALL SCOPY(im - 1, pfi(ig, ifield), 1, pdyn(1, j, ifield), 1)
     1778      pdyn(im, j, ifield) = pdyn(1, j, ifield)
     1779    ENDDO
     1780  ENDDO
     1781
     1782END SUBROUTINE gr_fi_dyn
     1783
     1784SUBROUTINE gr_dyn_fi(nfield, im, jm, ngrid, pdyn, pfi)
     1785  USE lmdz_ssum_scopy, ONLY: scopy
     1786
     1787  IMPLICIT NONE
     1788  !=======================================================================
     1789  !   passage d'un champ de la grille scalaire a la grille physique
     1790  !=======================================================================
     1791
     1792  !-----------------------------------------------------------------------
     1793  !   declarations:
     1794  !   -------------
     1795
     1796  INTEGER im, jm, ngrid, nfield
     1797  REAL pdyn(im, jm, nfield)
     1798  REAL pfi(ngrid, nfield)
     1799
     1800  INTEGER j, ifield, ig
     1801
     1802  !-----------------------------------------------------------------------
     1803  !   calcul:
     1804  !   -------
     1805
     1806  IF(ngrid/=2 + (jm - 2) * (im - 1).AND.ngrid/=1)                          &
     1807          &    STOP 'probleme de dim'
     1808  !   traitement des poles
     1809  CALL SCOPY(nfield, pdyn, im * jm, pfi, ngrid)
     1810  CALL SCOPY(nfield, pdyn(1, jm, 1), im * jm, pfi(ngrid, 1), ngrid)
     1811
     1812  !   traitement des point normaux
     1813  DO ifield = 1, nfield
     1814    DO j = 2, jm - 1
     1815      ig = 2 + (j - 2) * (im - 1)
     1816      CALL SCOPY(im - 1, pdyn(1, j, ifield), 1, pfi(ig, ifield), 1)
     1817    ENDDO
     1818  ENDDO
     1819END SUBROUTINE gr_dyn_fi

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90

    r5119 r5128  
    11MODULE lmdz_old_1dconv
    2   IMPLICIT NONE; PRIVATE
    3   PUBLIC get_uvd, copie
     2   PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
     3  PUBLIC get_uvd, copie, get_uvd2, rdgrads, spaces
    44CONTAINS
    55
    … …  
    6767    INTEGER itap
    6868    REAL dtime
    69     REAL ht(100)
    70     REAL hq(100)
    71     REAL hu(100)
    72     REAL hv(100)
    73     REAL hw(100)
    74     REAL hthturb(100)
    75     REAL hqturb(100)
     69    REAL ht(:)
     70    REAL hq(:)
     71    REAL hu(:)
     72    REAL hv(:)
     73    REAL hw(:)
     74    REAL hthturb(:)
     75    REAL hqturb(:)
    7676    REAL Ts, Ts_subr
    7777    LOGICAL imp_fcg
    … …  
    142142    ! variables destinees a la lecture du pas de temps du fichier de donnees
    143143    !---------------------------------------------------------------------
    144     character*80 aaa, atemps, spaces, apasmax
     144    character*80 aaa, atemps, apasmax
    145145    INTEGER nch, imn, ipa
    146     !---------------------------------------------------------------------
    147     !  procedures appelees
    148     external rdgrads    !lire en iterant dans forcing.dat
    149146    !---------------------------------------------------------------------
    150147    PRINT*, 'le pas itap est:', itap
    … …  
    583580
    584581    character*4 a
    585     character*80 aaa, anblvl, spaces
     582    character*80 aaa, anblvl
    586583    INTEGER nch
    587584
    … …  
    812809    ENDIF
    813810  END
    814   CHARACTER*(*) FUNCTION SPACES(STR, NSPACE)
     811  CHARACTER*(80) FUNCTION SPACES(STR, NSPACE)
    815812
    816813    ! CERN PROGLIB# M433    SPACES          .VERSION KERNFOR  4.14  860211
    … …  
    821818    !-    replaced by NSPACE blanks inside the string STR
    822819
    823     CHARACTER*(*) STR
    824     INTEGER nspace
     820    CHARACTER*(80) STR
     821    INTEGER nspace, IBLANK, ISPACE, INONBL, LENSPA
    825822
    826823    LENSPA = LEN(SPACES)
    … …  
    854851
    855852    CHARACTER*(*) STR, SSTR
    856     INTEGER I
     853    INTEGER I, LENS, LENSS
    857854
    858855    LENS = LEN(STR)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90

    r5117 r5128  
    22
    33MODULE lmdz_old_lmdz1d
    4   IMPLICIT NONE; PRIVATE
     4  USE lmdz_old_1dconv, ONLY: copie, get_uvd2, get_uvd, rdgrads, spaces
     5  USE lmdz_1dutils, ONLY: interp2_case_vertical, nudge_uv, nudge_rht, lstendh, nudge_uv_init, &
     6          nudge_rht_init, disvert0
     7   PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
    58  PUBLIC old_lmdz1d
    69CONTAINS

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90

    r5117 r5128  
    11MODULE lmdz_scm
    2   ; PRIVATE
     2  PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
    33  PUBLIC scm
    44CONTAINS
    … …  
    4141            itau_dyn, itau_phy, start_time, year_len
    4242    USE phys_cal_mod, ONLY: year_len_phys_cal_mod => year_len
    43     USE lmdz_1dutils, ONLY: fq_sat, conf_unicol, dyn1deta0, dyn1dredem
     43    USE lmdz_1dutils, ONLY: fq_sat, conf_unicol, dyn1deta0, dyn1dredem, disvert0
     44
    4445    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_OUTPUTPHYSSCM
    45     END SUBROUTINE scm
    46    
     46
    4747    INCLUDE "dimensions.h"
    4848    INCLUDE "YOMCST.h"

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90

    r5119 r5128  
    8888
    8989!=======================================================================
    90 SUBROUTINE abort_gcm(modname, message, ierr)
    91   USE IOIPSL
    92   ! Stops the simulation cleanly, closing files and printing various
    93   ! comments
    94   !=======================================================================
    95 
    96   !  Input: modname = name of calling program
    97   !         message = stuff to print
    98   !         ierr    = severity of situation ( = 0 normal )
    99 
    100   CHARACTER(LEN = *) modname
    101   INTEGER ierr
    102   CHARACTER(LEN = *) message
    103 
    104   WRITE(*, *) 'in abort_gcm'
    105   CALL histclo
    106   WRITE(*, *) 'out of histclo'
    107   WRITE(*, *) 'Stopping in ', modname
    108   WRITE(*, *) 'Reason = ', message
    109   CALL getin_dump
    110 
    111   IF (ierr == 0) THEN
    112     WRITE(*, *) 'Everything is cool'
    113   else
    114     WRITE(*, *) 'Houston, we have a problem ', ierr
    115   endif
    116   STOP
    117 END
    118 
    119 !=======================================================================
    12090SUBROUTINE gr_dyn_fi(nfield, im, jm, ngrid, pdyn, pfi)
    12191  USE lmdz_ssum_scopy, ONLY: scopy
Note: See TracChangeset for help on using the changeset viewer.