Changeset 6145 for LMDZ6


Ignore:
Timestamp:
Mar 27, 2026, 9:18:02 PM (2 weeks ago)
Author:
evignon
Message:

je sors le calcul des prorpriétés optiques des nuages de la section "rayonnement" de physiq_mod (appel tous les nbprad)

Location:
LMDZ6/trunk/libf
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r6142 r6145  
    38023802
    38033803
    3804 
    38053804    DO k = 1, klev
    38063805       DO i = 1, klon
    … …  
    39293928             ! profonde.
    39303929
    3931              !IM/FH: 2011/02/23
    3932              ! definition des points sur lesquels ls thermiques sont actifs
    39333930
    39343931             DO k=1,klev
    … …  
    39663963    ENDIF
    39673964
    3968     !===============================================================================
    3969     ! Interactive chemistry through coupling with INCA or REPROBUS chemistry models
    3970     !
    3971 
    3972     IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
    3973        IF (CPPKEY_INCA) THEN
    3974           CALL VTe(VTphysiq)
    3975           CALL VTb(VTinca)
    3976           calday = REAL(days_elapsed + 1) + jH_cur
    3977 
    3978           CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
    3979           CALL AEROSOL_METEO_CALC( &
    3980                calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
    3981                prfl,psfl,pctsrf,cell_area, &
    3982                latitude_deg,longitude_deg,u10m,v10m)
    3983 
    3984           zxsnow_dummy(:) = 0.0
    3985           ! INCA needs a cloud fraction that is not necessarily that
    3986           ! for radiation. Here we provide a cloud fraction calculated
    3987           ! the same manner as that in LMDZ5, LMDZ6 and LMDZ7
    3988           DO k=1,klev
    3989                 DO i=1,klon
    3990                    cldfra_inca(i,k)=min(rneb(i,k)+rnebcon(i,k),1.)
    3991                 ENDDO
    3992           ENDDO
    3993 
    3994 
    3995           CALL chemhook_begin (calday, &
    3996                days_elapsed+1, &
    3997                jH_cur, &
    3998                pctsrf(1,1), &
    3999                latitude_deg, &
    4000                longitude_deg, &
    4001                cell_area, &
    4002                paprs, &
    4003                pplay, &
    4004                coefh(1:klon,1:klev,is_ave), &
    4005                pphi, &
    4006                t_seri, &
    4007                u, &
    4008                v, &
    4009                rot, &
    4010                wo(:, :, 1), &
    4011                q_seri, &
    4012                zxtsol, &
    4013                zt2m, &
    4014                zxsnow_dummy, &
    4015                solsw, &
    4016                albsol1, &
    4017                rain_fall, &
    4018                snow_fall, &
    4019                itop_con, &
    4020                ibas_con, &
    4021                cldfra_inca, &
    4022                nbp_lon, &
    4023                nbp_lat-1, &
    4024                tr_seri(:,:,1+nqCO2:nbtr), &
    4025                ftsol, &
    4026                paprs, &
    4027                cdragh, &
    4028                cdragm, &
    4029                pctsrf, &
    4030                pdtphys, &
    4031                itap)
    4032 
    4033           CALL VTe(VTinca)
    4034           CALL VTb(VTphysiq)
    4035        END IF
    4036     ENDIF !type_trac = inca or inco
    4037    
    4038     IF (type_trac == 'repr') THEN
    4039        IF (CPPKEY_REPROBUS) THEN
    4040           CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
    4041        END IF
    4042     ENDIF
    4043 
    4044    
    4045     !===============================================================================
    4046     ! Radiative scheme and associated aerosols
    4047     !
    4048     ! Note that the following routines are called every radpas time steps
    4049 
    4050     IF (MOD(itaprad,radpas).EQ.0) THEN
    4051 
    4052        !
    4053        !jq - introduce the aerosol direct and first indirect radiative forcings
    4054        !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
    4055        IF (flag_aerosol .GT. 0) THEN
    4056           IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    4057              IF (.NOT. aerosol_couple) THEN
    4058                 !
    4059                 CALL readaerosol_optic( &
    4060                      debut, flag_aerosol, itap, jD_cur-jD_ref, &
    4061                      pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    4062                      mass_solu_aero, mass_solu_aero_pi,  &
    4063                      tau_aero, piz_aero, cg_aero,  &
    4064                      tausum_aero, tau3d_aero)
    4065              ENDIF
    4066           ELSE IF (iflag_rrtm .EQ.1) THEN  ! RRTM radiation
    4067              IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
    4068                 abort_message='config_inca=aero et rrtm=1 impossible'
    4069                 CALL abort_physic(modname,abort_message,1)
    4070              ELSE
    4071                 !
    4072 #ifdef CPP_RRTM
    4073                 IF (NSW.EQ.6) THEN
    4074                    !--new aerosol properties SW and LW
    4075                    !
    4076                    IF (CPPKEY_DUST) THEN
    4077                       !--SPL aerosol model
    4078                       CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
    4079                            tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
    4080                            tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
    4081                            tausum_aero, tau3d_aero)
    4082                    ELSE
    4083                       !--climatologies or INCA aerosols
    4084                       CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
    4085                            flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
    4086                            pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    4087                            tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
    4088                            tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
    4089                            tausum_aero, drytausum_aero, tau3d_aero)
    4090                    END IF
    4091 
    4092                    IF (flag_aerosol .EQ. 7) THEN
    4093                       CALL macv2sp(pphis,pplay,paprs,longitude_deg,latitude_deg,  &
    4094                            tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm,dNovrN)
    4095                    ENDIF
    4096 
    4097                    !
    4098                 ELSE IF (NSW.EQ.2) THEN
    4099                    !--for now we use the old aerosol properties
    4100                    !
    4101                    CALL readaerosol_optic( &
    4102                         debut, flag_aerosol, itap, jD_cur-jD_ref, &
    4103                         pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    4104                         mass_solu_aero, mass_solu_aero_pi,  &
    4105                         tau_aero, piz_aero, cg_aero,  &
    4106                         tausum_aero, tau3d_aero)
    4107                    !
    4108                    !--natural aerosols
    4109                    tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
    4110                    piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
    4111                    cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
    4112                    !--all aerosols
    4113                    tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
    4114                    piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
    4115                    cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
    4116                    !
    4117                    !--no LW optics
    4118                    tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
    4119                    !
    4120                 ELSE
    4121                    abort_message='Only NSW=2 or 6 are possible with ' &
    4122                         // 'aerosols and iflag_rrtm=1'
    4123                    CALL abort_physic(modname,abort_message,1)
    4124                 ENDIF
    4125 #else
    4126                 abort_message='You should compile with -rrtm if running ' &
    4127                      // 'with iflag_rrtm=1'
    4128                 CALL abort_physic(modname,abort_message,1)
    4129 #endif
    4130                 !
    4131              ENDIF
    4132           ELSE IF (iflag_rrtm .EQ.2) THEN    ! ecrad RADIATION
    4133 #ifdef CPP_ECRAD
    4134              !--climatologies or INCA aerosols
    4135              CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
    4136                   flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
    4137                   pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    4138                   tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
    4139 #else
    4140              abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
    4141              CALL abort_physic(modname,abort_message,1)
    4142 #endif
    4143           ENDIF
    4144 
    4145        ELSE   !--flag_aerosol = 0
    4146           tausum_aero(:,:,:) = 0.
    4147           drytausum_aero(:,:) = 0.
    4148           mass_solu_aero(:,:) = 0.
    4149           mass_solu_aero_pi(:,:) = 0.
    4150           IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    4151              tau_aero(:,:,:,:) = 1.e-15
    4152              piz_aero(:,:,:,:) = 1.
    4153              cg_aero(:,:,:,:)  = 0.
    4154           ELSE
    4155              tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
    4156              tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
    4157              piz_aero_sw_rrtm(:,:,:,:) = 1.0
    4158              cg_aero_sw_rrtm(:,:,:,:)  = 0.0
    4159           ENDIF
    4160        ENDIF
    4161        !
    4162        !--WMO criterion to determine tropopause
    4163        CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
    4164        !
    4165        !--STRAT AEROSOL
    4166        !--updates tausum_aero,tau_aero,piz_aero,cg_aero
    4167        IF (flag_aerosol_strat.GT.0) THEN
    4168           IF (prt_level .GE.10) THEN
    4169              PRINT *,'appel a readaerosolstrat', mth_cur
    4170           ENDIF
    4171           IF (iflag_rrtm.EQ.0) THEN
    4172              IF (flag_aerosol_strat.EQ.1) THEN
    4173                 CALL readaerosolstrato(debut)
    4174              ELSE
    4175                 abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
    4176                 CALL abort_physic(modname,abort_message,1)
    4177              ENDIF
    4178           ELSE
    4179 #ifdef CPP_RRTM
    4180              IF (.NOT. CPPKEY_STRATAER) THEN
    4181                 !--prescribed strat aerosols
    4182                 !--only in the case of non-interactive strat aerosols
    4183                 IF (flag_aerosol_strat.EQ.1) THEN
    4184                    CALL readaerosolstrato1_rrtm(debut)
    4185                 ELSEIF (flag_aerosol_strat.EQ.2) THEN
    4186                    CALL readaerosolstrato2_rrtm(debut, ok_volcan)
    4187                 ELSE
    4188                    abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
    4189                    CALL abort_physic(modname,abort_message,1)
    4190                 ENDIF
    4191              END IF
    4192 #else
    4193              abort_message='You should compile with -rrtm if running ' &
    4194                   // 'with iflag_rrtm=1'
    4195              CALL abort_physic(modname,abort_message,1)
    4196 #endif
    4197           ENDIF
    4198        ELSE
    4199           tausum_aero(:,:,id_STRAT_phy) = 0.
    4200        ENDIF
    4201        !
    4202 #ifdef CPP_RRTM
    4203        IF (CPPKEY_STRATAER) THEN
    4204           !--compute stratospheric mask
    4205           CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
    4206           !--interactive strat aerosols
    4207           CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
    4208        END IF
    4209 #endif
    4210        !--fin STRAT AEROSOL
    4211        !
    42123965
    42133966       ! Calculer les parametres optiques des nuages et quelques
    … …  
    42313984       CALL call_cloud_optics_prop_post()
    42323985
    4233        !
     3986       
    42343987       !IM betaCRF
    42353988       !
    … …  
    42914044          !
    42924045       ENDIF
     4046
     4047
     4048
     4049    !===============================================================================
     4050    ! Interactive chemistry through coupling with INCA or REPROBUS chemistry models
     4051    !
     4052
     4053    IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
     4054       IF (CPPKEY_INCA) THEN
     4055          CALL VTe(VTphysiq)
     4056          CALL VTb(VTinca)
     4057          calday = REAL(days_elapsed + 1) + jH_cur
     4058
     4059          CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
     4060          CALL AEROSOL_METEO_CALC( &
     4061               calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
     4062               prfl,psfl,pctsrf,cell_area, &
     4063               latitude_deg,longitude_deg,u10m,v10m)
     4064
     4065          zxsnow_dummy(:) = 0.0
     4066          ! INCA needs a cloud fraction that is not necessarily that
     4067          ! for radiation. Here we provide a cloud fraction calculated
     4068          ! the same manner as that in LMDZ5, LMDZ6 and LMDZ7
     4069          DO k=1,klev
     4070                DO i=1,klon
     4071                   cldfra_inca(i,k)=min(rneb(i,k)+rnebcon(i,k),1.)
     4072                ENDDO
     4073          ENDDO
     4074
     4075
     4076          CALL chemhook_begin (calday, &
     4077               days_elapsed+1, &
     4078               jH_cur, &
     4079               pctsrf(1,1), &
     4080               latitude_deg, &
     4081               longitude_deg, &
     4082               cell_area, &
     4083               paprs, &
     4084               pplay, &
     4085               coefh(1:klon,1:klev,is_ave), &
     4086               pphi, &
     4087               t_seri, &
     4088               u, &
     4089               v, &
     4090               rot, &
     4091               wo(:, :, 1), &
     4092               q_seri, &
     4093               zxtsol, &
     4094               zt2m, &
     4095               zxsnow_dummy, &
     4096               solsw, &
     4097               albsol1, &
     4098               rain_fall, &
     4099               snow_fall, &
     4100               itop_con, &
     4101               ibas_con, &
     4102               cldfra_inca, &
     4103               nbp_lon, &
     4104               nbp_lat-1, &
     4105               tr_seri(:,:,1+nqCO2:nbtr), &
     4106               ftsol, &
     4107               paprs, &
     4108               cdragh, &
     4109               cdragm, &
     4110               pctsrf, &
     4111               pdtphys, &
     4112               itap)
     4113
     4114          CALL VTe(VTinca)
     4115          CALL VTb(VTphysiq)
     4116       END IF
     4117    ENDIF !type_trac = inca or inco
     4118   
     4119    IF (type_trac == 'repr') THEN
     4120       IF (CPPKEY_REPROBUS) THEN
     4121          CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
     4122       END IF
     4123    ENDIF
     4124
     4125   
     4126    !===============================================================================
     4127    ! Radiative scheme and associated aerosols
     4128    !
     4129    ! Note that the following routines are called every radpas time steps
     4130
     4131    IF (MOD(itaprad,radpas).EQ.0) THEN
     4132
     4133       !
     4134       !jq - introduce the aerosol direct and first indirect radiative forcings
     4135       !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
     4136       IF (flag_aerosol .GT. 0) THEN
     4137          IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     4138             IF (.NOT. aerosol_couple) THEN
     4139                !
     4140                CALL readaerosol_optic( &
     4141                     debut, flag_aerosol, itap, jD_cur-jD_ref, &
     4142                     pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     4143                     mass_solu_aero, mass_solu_aero_pi,  &
     4144                     tau_aero, piz_aero, cg_aero,  &
     4145                     tausum_aero, tau3d_aero)
     4146             ENDIF
     4147          ELSE IF (iflag_rrtm .EQ.1) THEN  ! RRTM radiation
     4148             IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
     4149                abort_message='config_inca=aero et rrtm=1 impossible'
     4150                CALL abort_physic(modname,abort_message,1)
     4151             ELSE
     4152                !
     4153#ifdef CPP_RRTM
     4154                IF (NSW.EQ.6) THEN
     4155                   !--new aerosol properties SW and LW
     4156                   !
     4157                   IF (CPPKEY_DUST) THEN
     4158                      !--SPL aerosol model
     4159                      CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
     4160                           tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
     4161                           tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
     4162                           tausum_aero, tau3d_aero)
     4163                   ELSE
     4164                      !--climatologies or INCA aerosols
     4165                      CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
     4166                           flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
     4167                           pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     4168                           tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
     4169                           tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
     4170                           tausum_aero, drytausum_aero, tau3d_aero)
     4171                   END IF
     4172
     4173                   IF (flag_aerosol .EQ. 7) THEN
     4174                      CALL macv2sp(pphis,pplay,paprs,longitude_deg,latitude_deg,  &
     4175                           tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm,dNovrN)
     4176                   ENDIF
     4177
     4178                   !
     4179                ELSE IF (NSW.EQ.2) THEN
     4180                   !--for now we use the old aerosol properties
     4181                   !
     4182                   CALL readaerosol_optic( &
     4183                        debut, flag_aerosol, itap, jD_cur-jD_ref, &
     4184                        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     4185                        mass_solu_aero, mass_solu_aero_pi,  &
     4186                        tau_aero, piz_aero, cg_aero,  &
     4187                        tausum_aero, tau3d_aero)
     4188                   !
     4189                   !--natural aerosols
     4190                   tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
     4191                   piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
     4192                   cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
     4193                   !--all aerosols
     4194                   tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
     4195                   piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
     4196                   cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
     4197                   !
     4198                   !--no LW optics
     4199                   tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
     4200                   !
     4201                ELSE
     4202                   abort_message='Only NSW=2 or 6 are possible with ' &
     4203                        // 'aerosols and iflag_rrtm=1'
     4204                   CALL abort_physic(modname,abort_message,1)
     4205                ENDIF
     4206#else
     4207                abort_message='You should compile with -rrtm if running ' &
     4208                     // 'with iflag_rrtm=1'
     4209                CALL abort_physic(modname,abort_message,1)
     4210#endif
     4211                !
     4212             ENDIF
     4213          ELSE IF (iflag_rrtm .EQ.2) THEN    ! ecrad RADIATION
     4214#ifdef CPP_ECRAD
     4215             !--climatologies or INCA aerosols
     4216             CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
     4217                  flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
     4218                  pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     4219                  tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
     4220#else
     4221             abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
     4222             CALL abort_physic(modname,abort_message,1)
     4223#endif
     4224          ENDIF
     4225
     4226       ELSE   !--flag_aerosol = 0
     4227          tausum_aero(:,:,:) = 0.
     4228          drytausum_aero(:,:) = 0.
     4229          mass_solu_aero(:,:) = 0.
     4230          mass_solu_aero_pi(:,:) = 0.
     4231          IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     4232             tau_aero(:,:,:,:) = 1.e-15
     4233             piz_aero(:,:,:,:) = 1.
     4234             cg_aero(:,:,:,:)  = 0.
     4235          ELSE
     4236             tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
     4237             tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
     4238             piz_aero_sw_rrtm(:,:,:,:) = 1.0
     4239             cg_aero_sw_rrtm(:,:,:,:)  = 0.0
     4240          ENDIF
     4241       ENDIF
     4242       !
     4243       !--WMO criterion to determine tropopause
     4244       CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
     4245       !
     4246       !--STRAT AEROSOL
     4247       !--updates tausum_aero,tau_aero,piz_aero,cg_aero
     4248       IF (flag_aerosol_strat.GT.0) THEN
     4249          IF (prt_level .GE.10) THEN
     4250             PRINT *,'appel a readaerosolstrat', mth_cur
     4251          ENDIF
     4252          IF (iflag_rrtm.EQ.0) THEN
     4253             IF (flag_aerosol_strat.EQ.1) THEN
     4254                CALL readaerosolstrato(debut)
     4255             ELSE
     4256                abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
     4257                CALL abort_physic(modname,abort_message,1)
     4258             ENDIF
     4259          ELSE
     4260#ifdef CPP_RRTM
     4261             IF (.NOT. CPPKEY_STRATAER) THEN
     4262                !--prescribed strat aerosols
     4263                !--only in the case of non-interactive strat aerosols
     4264                IF (flag_aerosol_strat.EQ.1) THEN
     4265                   CALL readaerosolstrato1_rrtm(debut)
     4266                ELSEIF (flag_aerosol_strat.EQ.2) THEN
     4267                   CALL readaerosolstrato2_rrtm(debut, ok_volcan)
     4268                ELSE
     4269                   abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
     4270                   CALL abort_physic(modname,abort_message,1)
     4271                ENDIF
     4272             END IF
     4273#else
     4274             abort_message='You should compile with -rrtm if running ' &
     4275                  // 'with iflag_rrtm=1'
     4276             CALL abort_physic(modname,abort_message,1)
     4277#endif
     4278          ENDIF
     4279       ELSE
     4280          tausum_aero(:,:,id_STRAT_phy) = 0.
     4281       ENDIF
     4282       !
     4283#ifdef CPP_RRTM
     4284       IF (CPPKEY_STRATAER) THEN
     4285          !--compute stratospheric mask
     4286          CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
     4287          !--interactive strat aerosols
     4288          CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
     4289       END IF
     4290#endif
     4291       !--fin STRAT AEROSOL
     4292       !
    42934293
    42944294       !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek

  • LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90

    r6144 r6145  
    112112    USE calwake_mod, ONLY : calwake, calwake_first
    113113    USE lmdz_wake_ini, ONLY : wake_ini
     114    USE lmdz_cv_ini, ONLY : cv_ini
    114115    USE lmdz_cv_ini, ONLY : epmax, coef_epmax_cape, cvl_comp_threshold, cvl_sig2feed
    115116    USE lmdz_cv_ini, ONLY : iflag_cvl_sigd, iflag_clw, ok_adj_ema
    … …  
    51195120
    51205121!---------------------------------------------------------------------------
    5121     DO k = 1, klev
    5122        DO i = 1, klon
    5123           cldfra(i,k) = rneb(i,k)
    5124           ! keep only liquid droplets in radocond if not liqice_in_radocond
    5125           IF (.NOT.liqice_in_radocond) radocond(i,k) = ql_seri(i,k)
    5126        ENDDO
    5127     ENDDO
    5128 
    5129 
    5130     ! Option to activate the radiative effect of blowing snow (ok_rad_bs)
    5131     ! makes sense only if the new large scale condensation scheme is active
    5132     ! with the ok_icefra_lscp flag active as well
    5133 
    5134     IF (ok_bs .AND. ok_rad_bs) THEN
    5135      !  IF (ok_icefra_lscp) THEN
    5136            DO k=1,klev
    5137              DO i=1,klon
    5138                 radocond(i,k)=radocond(i,k)+qbs_seri(i,k)
    5139                 picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k))
    5140                 qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0)
    5141                 cldfra(i,k)=max(cldfra(i,k),qbsfra)
    5142              ENDDO
    5143            ENDDO
    5144       !ELSE
    5145       !    WRITE(lunout,*)"PAY ATTENTION, you try to activate the radiative effect of blowing snow"
    5146       !    WRITE(lunout,*)"with ok_new_lscp=false and/or ok_icefra_lscp=false"
    5147       !    abort_message='inconsistency in cloud phase for blowing snow'
    5148       !    CALL abort_physic(modname,abort_message,1)
    5149       ! ENDIF
    5150 
    5151     ENDIF
    51525122#ifdef ISO     
    51535123!#ifdef ISOVERIF
    … …  
    52735243
    52745244    !
    5275     !-------------------------------------------------------------------
    5276     !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
    5277     !-------------------------------------------------------------------
    5278 
    5279     ! 1. NUAGES CONVECTIFS
    5280     !
    5281     !IM cf FH
    5282     !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
    5283     IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
    5284        snow_tiedtke=0.
    5285        !     print*,'avant calcul de la pseudo precip '
    5286        !     print*,'iflag_cld_th',iflag_cld_th
    5287        IF (iflag_cld_th.eq.-1) THEN
    5288           rain_tiedtke=rain_con
    5289        ELSE
    5290           !       print*,'calcul de la pseudo precip '
    5291           rain_tiedtke=0.
    5292           !         print*,'calcul de la pseudo precip 0'
    5293           DO k=1,klev
    5294              DO i=1,klon
    5295                 IF (d_q_con(i,k).lt.0.) THEN
    5296                    rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
    5297                         *(paprs(i,k)-paprs(i,k+1))/rg
    5298                 ENDIF
    5299              ENDDO
    5300           ENDDO
    5301        ENDIF
    5302        !
    5303        !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
    5304        !
    5305 
    5306        ! Nuages diagnostiques pour Tiedtke
    5307        CALL diagcld1(paprs,pplay, &
    5308                                 !IM cf FH. rain_con,snow_con,ibas_con,itop_con,
    5309             rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
    5310             diafra,dialiq)
    5311        DO k = 1, klev
    5312           DO i = 1, klon
    5313              IF (diafra(i,k).GT.cldfra(i,k)) THEN
    5314                 radocond(i,k) = dialiq(i,k)
    5315                 cldfra(i,k) = diafra(i,k)
    5316              ENDIF
    5317           ENDDO
    5318        ENDDO
    5319 
    5320     ELSE IF (iflag_cld_th.ge.3) THEN
    5321        !  On prend pour les nuages convectifs le max du calcul de la
    5322        !  convection et du calcul du pas de temps precedent diminue d'un facteur
    5323        !  facttemps
    5324        facteur = pdtphys *facttemps
    5325        DO k=1,klev
    5326           DO i=1,klon
    5327              rnebcon(i,k)=rnebcon(i,k)*facteur
    5328              IF (rnebcon0(i,k)*clwcon0(i,k).GT.rnebcon(i,k)*clwcon(i,k)) THEN
    5329                 rnebcon(i,k)=rnebcon0(i,k)
    5330                 clwcon(i,k)=clwcon0(i,k)
    5331              ENDIF
    5332           ENDDO
    5333        ENDDO
    5334 
    5335        !   On prend la somme des fractions nuageuses et des contenus en eau
    5336 
    5337        IF (iflag_cld_th>=5) THEN
    5338 
    5339           DO k=1,klev
    5340              ptconvth(:,k)=fm_therm(:,k+1)>0.
    5341           ENDDO
    5342 
    5343           IF (iflag_coupl==4) THEN
    5344 
    5345              ! Dans le cas iflag_coupl==4, on prend la somme des convertures
    5346              ! convectives et lsc dans la partie des thermiques
    5347              ! Le controle par iflag_coupl est peut etre provisoire.
    5348              DO k=1,klev
    5349                 DO i=1,klon
    5350                    IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
    5351                       radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
    5352                       cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    5353                    ELSE IF (ptconv(i,k)) THEN
    5354                       cldfra(i,k)=rnebcon(i,k)
    5355                       radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
    5356                    ENDIF
    5357                 ENDDO
    5358              ENDDO
    5359 
    5360           ELSE IF (iflag_coupl==5) THEN
    5361              DO k=1,klev
    5362                 DO i=1,klon
    5363                    cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    5364                    radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
    5365                 ENDDO
    5366              ENDDO
    5367 
    5368           ELSE
    5369 
    5370              ! Si on est sur un point touche par la convection
    5371              ! profonde et pas par les thermiques, on prend la
    5372              ! couverture nuageuse et l'eau nuageuse de la convection
    5373              ! profonde.
    5374 
    5375              !IM/FH: 2011/02/23
    5376              ! definition des points sur lesquels ls thermiques sont actifs
    5377 
    5378              DO k=1,klev
    5379                 DO i=1,klon
    5380                    IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
    5381                       cldfra(i,k)=rnebcon(i,k)
    5382                       radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
    5383                    ENDIF
    5384                 ENDDO
    5385              ENDDO
    5386 
    5387           ENDIF
    5388 
    5389        ELSE
    5390 
    5391           ! Ancienne version
    5392           cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
    5393           radocond(:,:)=radocond(:,:)+rnebcon(:,:)*clwcon(:,:)
    5394        ENDIF
    5395 
    5396     ENDIF
    5397 
    5398     ! 2. NUAGES STARTIFORMES
    5399     !
    5400     IF (ok_stratus) THEN
    5401        CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
    5402        DO k = 1, klev
    5403           DO i = 1, klon
    5404              IF (diafra(i,k).GT.cldfra(i,k)) THEN
    5405                 radocond(i,k) = dialiq(i,k)
    5406                 cldfra(i,k) = diafra(i,k)
    5407              ENDIF
    5408           ENDDO
    5409        ENDDO
    5410     ENDIF
    5411     !
    54125245    ! Precipitation totale
    54135246    !
    … …  
    54805313      endif
    54815314#endif   
     5315 
    54825316    !
    54835317    ! Calculer l'humidite relative pour diagnostique
    … …  
    55135347    ENDDO
    55145348
    5515     IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
    5516 IF (CPPKEY_INCA) THEN
    5517        CALL VTe(VTphysiq)
    5518        CALL VTb(VTinca)
    5519        calday = REAL(days_elapsed + 1) + jH_cur
    5520 
    5521        CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
    5522        CALL AEROSOL_METEO_CALC( &
    5523             calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
    5524             prfl,psfl,pctsrf,cell_area, &
    5525             latitude_deg,longitude_deg,u10m,v10m)
    5526 
    5527        zxsnow_dummy(:) = 0.0
    5528           ! INCA needs a cloud fraction that is not necessarily that
    5529           ! for radiation. Here we provide a cloud fraction calculated
    5530           ! the same manner as that in LMDZ5, LMDZ6 and LMDZ7
     5349
     5350    !
     5351    !-------------------------------------------------------------------
     5352    !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
     5353    !-------------------------------------------------------------------
     5354
     5355    DO k = 1, klev
     5356       DO i = 1, klon
     5357          cldfra(i,k) = rneb(i,k)
     5358          ! keep only liquid droplets in radocond if not liqice_in_radocond
     5359          IF (.NOT.liqice_in_radocond) radocond(i,k) = ql_seri(i,k)
     5360       ENDDO
     5361    ENDDO
     5362
     5363
     5364    ! Option to activate the radiative effect of blowing snow (ok_rad_bs)
     5365    ! makes sense only if the new large scale condensation scheme is active
     5366    ! with the ok_icefra_lscp flag active as well
     5367
     5368    IF (ok_bs .AND. ok_rad_bs) THEN
     5369     !  IF (ok_icefra_lscp) THEN
     5370           DO k=1,klev
     5371             DO i=1,klon
     5372                radocond(i,k)=radocond(i,k)+qbs_seri(i,k)
     5373                picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k))
     5374                qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0)
     5375                cldfra(i,k)=max(cldfra(i,k),qbsfra)
     5376             ENDDO
     5377           ENDDO
     5378      !ELSE
     5379      !    WRITE(lunout,*)"PAY ATTENTION, you try to activate the radiative effect of blowing snow"
     5380      !    WRITE(lunout,*)"with ok_new_lscp=false and/or ok_icefra_lscp=false"
     5381      !    abort_message='inconsistency in cloud phase for blowing snow'
     5382      !    CALL abort_physic(modname,abort_message,1)
     5383      ! ENDIF
     5384
     5385    ENDIF
     5386
     5387    ! 1. NUAGES CONVECTIFS
     5388    !
     5389    !IM cf FH
     5390    !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
     5391    IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
     5392       snow_tiedtke=0.
     5393       !     print*,'avant calcul de la pseudo precip '
     5394       !     print*,'iflag_cld_th',iflag_cld_th
     5395       IF (iflag_cld_th.eq.-1) THEN
     5396          rain_tiedtke=rain_con
     5397       ELSE
     5398          !       print*,'calcul de la pseudo precip '
     5399          rain_tiedtke=0.
     5400          !         print*,'calcul de la pseudo precip 0'
    55315401          DO k=1,klev
     5402             DO i=1,klon
     5403                IF (d_q_con(i,k).lt.0.) THEN
     5404                   rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
     5405                        *(paprs(i,k)-paprs(i,k+1))/rg
     5406                ENDIF
     5407             ENDDO
     5408          ENDDO
     5409       ENDIF
     5410       !
     5411       !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
     5412       !
     5413
     5414       ! Nuages diagnostiques pour Tiedtke
     5415       CALL diagcld1(paprs,pplay, &
     5416                                !IM cf FH. rain_con,snow_con,ibas_con,itop_con,
     5417            rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
     5418            diafra,dialiq)
     5419       DO k = 1, klev
     5420          DO i = 1, klon
     5421             IF (diafra(i,k).GT.cldfra(i,k)) THEN
     5422                radocond(i,k) = dialiq(i,k)
     5423                cldfra(i,k) = diafra(i,k)
     5424             ENDIF
     5425          ENDDO
     5426       ENDDO
     5427
     5428    ELSE IF (iflag_cld_th.ge.3) THEN
     5429       !  On prend pour les nuages convectifs le max du calcul de la
     5430       !  convection et du calcul du pas de temps precedent diminue d'un facteur
     5431       !  facttemps
     5432       facteur = pdtphys *facttemps
     5433       DO k=1,klev
     5434          DO i=1,klon
     5435             rnebcon(i,k)=rnebcon(i,k)*facteur
     5436             IF (rnebcon0(i,k)*clwcon0(i,k).GT.rnebcon(i,k)*clwcon(i,k)) THEN
     5437                rnebcon(i,k)=rnebcon0(i,k)
     5438                clwcon(i,k)=clwcon0(i,k)
     5439             ENDIF
     5440          ENDDO
     5441       ENDDO
     5442
     5443       !   On prend la somme des fractions nuageuses et des contenus en eau
     5444
     5445       IF (iflag_cld_th>=5) THEN
     5446
     5447          DO k=1,klev
     5448             ptconvth(:,k)=fm_therm(:,k+1)>0.
     5449          ENDDO
     5450
     5451          IF (iflag_coupl==4) THEN
     5452
     5453             ! Dans le cas iflag_coupl==4, on prend la somme des convertures
     5454             ! convectives et lsc dans la partie des thermiques
     5455             ! Le controle par iflag_coupl est peut etre provisoire.
     5456             DO k=1,klev
    55325457                DO i=1,klon
    5533                    cldfra_inca(i,k)=min(rneb(i,k)+rnebcon(i,k),1.)
     5458                   IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
     5459                      radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
     5460                      cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
     5461                   ELSE IF (ptconv(i,k)) THEN
     5462                      cldfra(i,k)=rnebcon(i,k)
     5463                      radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
     5464                   ENDIF
    55345465                ENDDO
     5466             ENDDO
     5467
     5468          ELSE IF (iflag_coupl==5) THEN
     5469             DO k=1,klev
     5470                DO i=1,klon
     5471                   cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
     5472                   radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
     5473                ENDDO
     5474             ENDDO
     5475
     5476          ELSE
     5477
     5478             ! Si on est sur un point touche par la convection
     5479             ! profonde et pas par les thermiques, on prend la
     5480             ! couverture nuageuse et l'eau nuageuse de la convection
     5481             ! profonde.
     5482
     5483             !IM/FH: 2011/02/23
     5484             ! definition des points sur lesquels ls thermiques sont actifs
     5485
     5486             DO k=1,klev
     5487                DO i=1,klon
     5488                   IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
     5489                      cldfra(i,k)=rnebcon(i,k)
     5490                      radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
     5491                   ENDIF
     5492                ENDDO
     5493             ENDDO
     5494
     5495          ENDIF
     5496
     5497       ELSE
     5498
     5499          ! Ancienne version
     5500          cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
     5501          radocond(:,:)=radocond(:,:)+rnebcon(:,:)*clwcon(:,:)
     5502       ENDIF
     5503
     5504    ENDIF
     5505
     5506    ! 2. NUAGES STARTIFORMES
     5507    !
     5508    IF (ok_stratus) THEN
     5509       CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
     5510       DO k = 1, klev
     5511          DO i = 1, klon
     5512             IF (diafra(i,k).GT.cldfra(i,k)) THEN
     5513                radocond(i,k) = dialiq(i,k)
     5514                cldfra(i,k) = diafra(i,k)
     5515             ENDIF
    55355516          ENDDO
    5536 
    5537 
    5538        CALL chemhook_begin (calday, &
    5539             days_elapsed+1, &
    5540             jH_cur, &
    5541             pctsrf(1,1), &
    5542             latitude_deg, &
    5543             longitude_deg, &
    5544             cell_area, &
    5545             paprs, &
    5546             pplay, &
    5547             coefh(1:klon,1:klev,is_ave), &
    5548             pphi, &
    5549             t_seri, &
    5550             u, &
    5551             v, &
    5552             rot, &
    5553             wo(:, :, 1), &
    5554             q_seri, &
    5555             zxtsol, &
    5556             zt2m, &
    5557             zxsnow_dummy, &
    5558             solsw, &
    5559             albsol1, &
    5560             rain_fall, &
    5561             snow_fall, &
    5562             itop_con, &
    5563             ibas_con, &
    5564             cldfra, &
    5565             nbp_lon, &
    5566             nbp_lat-1, &
    5567             tr_seri(:,:,1+nqCO2:nbtr), &
    5568             ftsol, &
    5569             paprs, &
    5570             cdragh, &
    5571             cdragm, &
    5572             pctsrf, &
    5573             pdtphys, &
    5574             itap)
    5575 
    5576        CALL VTe(VTinca)
    5577        CALL VTb(VTphysiq)
    5578 END IF
    5579     ENDIF !type_trac = inca or inco
    5580     IF (type_trac == 'repr') THEN
    5581 IF (CPPKEY_REPROBUS) THEN
    5582     !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
    5583     CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
    5584 END IF
     5517       ENDDO
    55855518    ENDIF
    5586 
    5587     !
    5588     ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
    5589     !
    5590     IF (MOD(itaprad,radpas).EQ.0) THEN
    5591 
    5592        !
    5593        !jq - introduce the aerosol direct and first indirect radiative forcings
    5594        !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
    5595        IF (flag_aerosol .GT. 0) THEN
    5596           IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    5597              IF (.NOT. aerosol_couple) THEN
    5598                 !
    5599                 CALL readaerosol_optic( &
    5600                      debut, flag_aerosol, itap, jD_cur-jD_ref, &
    5601                      pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    5602                      mass_solu_aero, mass_solu_aero_pi,  &
    5603                      tau_aero, piz_aero, cg_aero,  &
    5604                      tausum_aero, tau3d_aero)
    5605              ENDIF
    5606           ELSE IF (iflag_rrtm .EQ.1) THEN  ! RRTM radiation
    5607              IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
    5608                 abort_message='config_inca=aero et rrtm=1 impossible'
    5609                 CALL abort_physic(modname,abort_message,1)
    5610              ELSE
    5611                 !
    5612 #ifdef CPP_RRTM
    5613                 IF (NSW.EQ.6) THEN
    5614                    !--new aerosol properties SW and LW
    5615                    !
    5616 IF (CPPKEY_DUST) THEN
    5617                    !--SPL aerosol model
    5618                    CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
    5619                         tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
    5620                         tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
    5621                         tausum_aero, tau3d_aero)
    5622 ELSE
    5623                    !--climatologies or INCA aerosols
    5624                    CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
    5625                         flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
    5626                         pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    5627                         tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
    5628                         tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
    5629                         tausum_aero, drytausum_aero, tau3d_aero)
    5630 END IF
    5631 
    5632                    IF (flag_aerosol .EQ. 7) THEN
    5633                       CALL macv2sp(pphis,pplay,paprs,longitude_deg,latitude_deg,  &
    5634                            tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm,dNovrN)
    5635                    ENDIF
    5636 
    5637                    !
    5638                 ELSE IF (NSW.EQ.2) THEN
    5639                    !--for now we use the old aerosol properties
    5640                    !
    5641                    CALL readaerosol_optic( &
    5642                         debut, flag_aerosol, itap, jD_cur-jD_ref, &
    5643                         pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    5644                         mass_solu_aero, mass_solu_aero_pi,  &
    5645                         tau_aero, piz_aero, cg_aero,  &
    5646                         tausum_aero, tau3d_aero)
    5647                    !
    5648                    !--natural aerosols
    5649                    tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
    5650                    piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
    5651                    cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
    5652                    !--all aerosols
    5653                    tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
    5654                    piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
    5655                    cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
    5656                    !
    5657                    !--no LW optics
    5658                    tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
    5659                    !
    5660                 ELSE
    5661                    abort_message='Only NSW=2 or 6 are possible with ' &
    5662                         // 'aerosols and iflag_rrtm=1'
    5663                    CALL abort_physic(modname,abort_message,1)
    5664                 ENDIF
    5665 #else
    5666                 abort_message='You should compile with -rrtm if running ' &
    5667                      // 'with iflag_rrtm=1'
    5668                 CALL abort_physic(modname,abort_message,1)
    5669 #endif
    5670                 !
    5671              ENDIF
    5672           ELSE IF (iflag_rrtm .EQ.2) THEN    ! ecrad RADIATION
    5673 #ifdef CPP_ECRAD
    5674              !--climatologies or INCA aerosols
    5675              CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
    5676                   flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
    5677                   pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    5678                   tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
    5679 #else
    5680                 abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
    5681                 CALL abort_physic(modname,abort_message,1)
    5682 #endif
    5683           ENDIF
    5684        ELSE   !--flag_aerosol = 0
    5685           tausum_aero(:,:,:) = 0.
    5686           drytausum_aero(:,:) = 0.
    5687           mass_solu_aero(:,:) = 0.
    5688           mass_solu_aero_pi(:,:) = 0.
    5689           IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    5690              tau_aero(:,:,:,:) = 1.e-15
    5691              piz_aero(:,:,:,:) = 1.
    5692              cg_aero(:,:,:,:)  = 0.
    5693           ELSE
    5694              tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
    5695              tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
    5696              piz_aero_sw_rrtm(:,:,:,:) = 1.0
    5697              cg_aero_sw_rrtm(:,:,:,:)  = 0.0
    5698           ENDIF
    5699        ENDIF
    5700        !
    5701        !--WMO criterion to determine tropopause
    5702        CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
    5703        !
    5704        !--STRAT AEROSOL
    5705        !--updates tausum_aero,tau_aero,piz_aero,cg_aero
    5706        IF (flag_aerosol_strat.GT.0) THEN
    5707           IF (prt_level .GE.10) THEN
    5708              PRINT *,'appel a readaerosolstrat', mth_cur
    5709           ENDIF
    5710           IF (iflag_rrtm.EQ.0) THEN
    5711            IF (flag_aerosol_strat.EQ.1) THEN
    5712              CALL readaerosolstrato(debut)
    5713            ELSE
    5714              abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
    5715              CALL abort_physic(modname,abort_message,1)
    5716            ENDIF
    5717           ELSE
    5718 #ifdef CPP_RRTM
    5719 IF (.NOT. CPPKEY_STRATAER) THEN
    5720           !--prescribed strat aerosols
    5721           !--only in the case of non-interactive strat aerosols
    5722             IF (flag_aerosol_strat.EQ.1) THEN
    5723              CALL readaerosolstrato1_rrtm(debut)
    5724             ELSEIF (flag_aerosol_strat.EQ.2) THEN
    5725              CALL readaerosolstrato2_rrtm(debut, ok_volcan)
    5726             ELSE
    5727              abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
    5728              CALL abort_physic(modname,abort_message,1)
    5729             ENDIF
    5730 END IF
    5731 #else
    5732              abort_message='You should compile with -rrtm if running ' &
    5733                   // 'with iflag_rrtm=1'
    5734              CALL abort_physic(modname,abort_message,1)
    5735 #endif
    5736           ENDIF
    5737        ELSE
    5738           tausum_aero(:,:,id_STRAT_phy) = 0.
    5739        ENDIF
    5740 !
    5741 #ifdef CPP_RRTM
    5742 IF (CPPKEY_STRATAER) THEN
    5743 #ifdef ISO
    5744        CALL abort_gcm("physiq_mod", "StratAer isn't ISO-compatible for now, 07/24",1)
    5745 #endif
    5746        !--compute stratospheric mask
    5747        CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
    5748        !--interactive strat aerosols
    5749        CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
    5750 END IF
    5751 #endif
    5752        !--fin STRAT AEROSOL
    5753        !
    57545519
    57555520       ! Calculer les parametres optiques des nuages et quelques
    … …  
    58335598       !
    58345599       ENDIF
     5600
     5601
     5602    IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
     5603IF (CPPKEY_INCA) THEN
     5604       CALL VTe(VTphysiq)
     5605       CALL VTb(VTinca)
     5606       calday = REAL(days_elapsed + 1) + jH_cur
     5607
     5608       CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
     5609       CALL AEROSOL_METEO_CALC( &
     5610            calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
     5611            prfl,psfl,pctsrf,cell_area, &
     5612            latitude_deg,longitude_deg,u10m,v10m)
     5613
     5614       zxsnow_dummy(:) = 0.0
     5615          ! INCA needs a cloud fraction that is not necessarily that
     5616          ! for radiation. Here we provide a cloud fraction calculated
     5617          ! the same manner as that in LMDZ5, LMDZ6 and LMDZ7
     5618          DO k=1,klev
     5619                DO i=1,klon
     5620                   cldfra_inca(i,k)=min(rneb(i,k)+rnebcon(i,k),1.)
     5621                ENDDO
     5622          ENDDO
     5623
     5624
     5625       CALL chemhook_begin (calday, &
     5626            days_elapsed+1, &
     5627            jH_cur, &
     5628            pctsrf(1,1), &
     5629            latitude_deg, &
     5630            longitude_deg, &
     5631            cell_area, &
     5632            paprs, &
     5633            pplay, &
     5634            coefh(1:klon,1:klev,is_ave), &
     5635            pphi, &
     5636            t_seri, &
     5637            u, &
     5638            v, &
     5639            rot, &
     5640            wo(:, :, 1), &
     5641            q_seri, &
     5642            zxtsol, &
     5643            zt2m, &
     5644            zxsnow_dummy, &
     5645            solsw, &
     5646            albsol1, &
     5647            rain_fall, &
     5648            snow_fall, &
     5649            itop_con, &
     5650            ibas_con, &
     5651            cldfra, &
     5652            nbp_lon, &
     5653            nbp_lat-1, &
     5654            tr_seri(:,:,1+nqCO2:nbtr), &
     5655            ftsol, &
     5656            paprs, &
     5657            cdragh, &
     5658            cdragm, &
     5659            pctsrf, &
     5660            pdtphys, &
     5661            itap)
     5662
     5663       CALL VTe(VTinca)
     5664       CALL VTb(VTphysiq)
     5665END IF
     5666    ENDIF !type_trac = inca or inco
     5667    IF (type_trac == 'repr') THEN
     5668IF (CPPKEY_REPROBUS) THEN
     5669    !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
     5670    CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
     5671END IF
     5672    ENDIF
     5673
     5674    !
     5675    ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
     5676    !
     5677    IF (MOD(itaprad,radpas).EQ.0) THEN
     5678
     5679       !
     5680       !jq - introduce the aerosol direct and first indirect radiative forcings
     5681       !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
     5682       IF (flag_aerosol .GT. 0) THEN
     5683          IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     5684             IF (.NOT. aerosol_couple) THEN
     5685                !
     5686                CALL readaerosol_optic( &
     5687                     debut, flag_aerosol, itap, jD_cur-jD_ref, &
     5688                     pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     5689                     mass_solu_aero, mass_solu_aero_pi,  &
     5690                     tau_aero, piz_aero, cg_aero,  &
     5691                     tausum_aero, tau3d_aero)
     5692             ENDIF
     5693          ELSE IF (iflag_rrtm .EQ.1) THEN  ! RRTM radiation
     5694             IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
     5695                abort_message='config_inca=aero et rrtm=1 impossible'
     5696                CALL abort_physic(modname,abort_message,1)
     5697             ELSE
     5698                !
     5699#ifdef CPP_RRTM
     5700                IF (NSW.EQ.6) THEN
     5701                   !--new aerosol properties SW and LW
     5702                   !
     5703IF (CPPKEY_DUST) THEN
     5704                   !--SPL aerosol model
     5705                   CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
     5706                        tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
     5707                        tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
     5708                        tausum_aero, tau3d_aero)
     5709ELSE
     5710                   !--climatologies or INCA aerosols
     5711                   CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
     5712                        flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
     5713                        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     5714                        tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
     5715                        tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
     5716                        tausum_aero, drytausum_aero, tau3d_aero)
     5717END IF
     5718
     5719                   IF (flag_aerosol .EQ. 7) THEN
     5720                      CALL macv2sp(pphis,pplay,paprs,longitude_deg,latitude_deg,  &
     5721                           tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm,dNovrN)
     5722                   ENDIF
     5723
     5724                   !
     5725                ELSE IF (NSW.EQ.2) THEN
     5726                   !--for now we use the old aerosol properties
     5727                   !
     5728                   CALL readaerosol_optic( &
     5729                        debut, flag_aerosol, itap, jD_cur-jD_ref, &
     5730                        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     5731                        mass_solu_aero, mass_solu_aero_pi,  &
     5732                        tau_aero, piz_aero, cg_aero,  &
     5733                        tausum_aero, tau3d_aero)
     5734                   !
     5735                   !--natural aerosols
     5736                   tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
     5737                   piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
     5738                   cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
     5739                   !--all aerosols
     5740                   tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
     5741                   piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
     5742                   cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
     5743                   !
     5744                   !--no LW optics
     5745                   tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
     5746                   !
     5747                ELSE
     5748                   abort_message='Only NSW=2 or 6 are possible with ' &
     5749                        // 'aerosols and iflag_rrtm=1'
     5750                   CALL abort_physic(modname,abort_message,1)
     5751                ENDIF
     5752#else
     5753                abort_message='You should compile with -rrtm if running ' &
     5754                     // 'with iflag_rrtm=1'
     5755                CALL abort_physic(modname,abort_message,1)
     5756#endif
     5757                !
     5758             ENDIF
     5759          ELSE IF (iflag_rrtm .EQ.2) THEN    ! ecrad RADIATION
     5760#ifdef CPP_ECRAD
     5761             !--climatologies or INCA aerosols
     5762             CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
     5763                  flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
     5764                  pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     5765                  tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
     5766#else
     5767                abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
     5768                CALL abort_physic(modname,abort_message,1)
     5769#endif
     5770          ENDIF
     5771       ELSE   !--flag_aerosol = 0
     5772          tausum_aero(:,:,:) = 0.
     5773          drytausum_aero(:,:) = 0.
     5774          mass_solu_aero(:,:) = 0.
     5775          mass_solu_aero_pi(:,:) = 0.
     5776          IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     5777             tau_aero(:,:,:,:) = 1.e-15
     5778             piz_aero(:,:,:,:) = 1.
     5779             cg_aero(:,:,:,:)  = 0.
     5780          ELSE
     5781             tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
     5782             tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
     5783             piz_aero_sw_rrtm(:,:,:,:) = 1.0
     5784             cg_aero_sw_rrtm(:,:,:,:)  = 0.0
     5785          ENDIF
     5786       ENDIF
     5787       !
     5788       !--WMO criterion to determine tropopause
     5789       CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
     5790       !
     5791       !--STRAT AEROSOL
     5792       !--updates tausum_aero,tau_aero,piz_aero,cg_aero
     5793       IF (flag_aerosol_strat.GT.0) THEN
     5794          IF (prt_level .GE.10) THEN
     5795             PRINT *,'appel a readaerosolstrat', mth_cur
     5796          ENDIF
     5797          IF (iflag_rrtm.EQ.0) THEN
     5798           IF (flag_aerosol_strat.EQ.1) THEN
     5799             CALL readaerosolstrato(debut)
     5800           ELSE
     5801             abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
     5802             CALL abort_physic(modname,abort_message,1)
     5803           ENDIF
     5804          ELSE
     5805#ifdef CPP_RRTM
     5806IF (.NOT. CPPKEY_STRATAER) THEN
     5807          !--prescribed strat aerosols
     5808          !--only in the case of non-interactive strat aerosols
     5809            IF (flag_aerosol_strat.EQ.1) THEN
     5810             CALL readaerosolstrato1_rrtm(debut)
     5811            ELSEIF (flag_aerosol_strat.EQ.2) THEN
     5812             CALL readaerosolstrato2_rrtm(debut, ok_volcan)
     5813            ELSE
     5814             abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
     5815             CALL abort_physic(modname,abort_message,1)
     5816            ENDIF
     5817END IF
     5818#else
     5819             abort_message='You should compile with -rrtm if running ' &
     5820                  // 'with iflag_rrtm=1'
     5821             CALL abort_physic(modname,abort_message,1)
     5822#endif
     5823          ENDIF
     5824       ELSE
     5825          tausum_aero(:,:,id_STRAT_phy) = 0.
     5826       ENDIF
     5827!
     5828#ifdef CPP_RRTM
     5829IF (CPPKEY_STRATAER) THEN
     5830#ifdef ISO
     5831       CALL abort_gcm("physiq_mod", "StratAer isn't ISO-compatible for now, 07/24",1)
     5832#endif
     5833       !--compute stratospheric mask
     5834       CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
     5835       !--interactive strat aerosols
     5836       CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
     5837END IF
     5838#endif
     5839       !--fin STRAT AEROSOL
     5840       !
    58355841
    58365842       !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek
Note: See TracChangeset for help on using the changeset viewer.