Changeset 2845 for LMDZ5


Ignore:
Timestamp:
Apr 6, 2017, 6:21:59 PM (8 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2838:2842 into testing branch

Location:
LMDZ5/branches/testing
Files:
16 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/DefLists/field_def_lmdz.xml

    r2839 r2845  
    338338        <field id="od550aer"    long_name="Total aerosol optical depth at 550nm"    unit="-" />
    339339        <field id="od865aer"    long_name="Total aerosol optical depth at 870nm"    unit="-" />
    340         <field id="absvisaer"    long_name="Absorption aerosol visible optical depth"    unit="-" />
     340        <field id="abs550aer"    long_name="Absorption aerosol optical depth at 550nm"    unit="-" />
    341341        <field id="od550lt1aer"    long_name="Fine mode optical depth"    unit="-" />
    342342        <field id="sconcso4"    long_name="Surface Concentration of Sulfate "    unit="kg/m3" />

  • LMDZ5/branches/testing/DefLists/file_def_histLES_lmdz.xml

    r2839 r2845  
    337337                <field field_ref="od550aer" level="10" />
    338338                <field field_ref="od865aer" level="10" />
    339                 <field field_ref="absvisaer" level="10" />
     339                <field field_ref="abs550aer" level="10" />
    340340                <field field_ref="od550lt1aer" level="10" />
    341341                <field field_ref="sconcso4" level="10" />

  • LMDZ5/branches/testing/DefLists/file_def_histday_lmdz.xml

    r2839 r2845  
    343343                <field field_ref="od550aer" level="6" />
    344344                <field field_ref="od865aer" level="6" />
    345                 <field field_ref="absvisaer" level="6" />
     345                <field field_ref="abs550aer" level="6" />
    346346                <field field_ref="od550lt1aer" level="6" />
    347347                <field field_ref="sconcso4" level="6" />

  • LMDZ5/branches/testing/DefLists/file_def_histhf_lmdz.xml

    r2839 r2845  
    337337                <field field_ref="od550aer" level="10" />
    338338                <field field_ref="od865aer" level="10" />
    339                 <field field_ref="absvisaer" level="10" />
     339                <field field_ref="abs550aer" level="10" />
    340340                <field field_ref="od550lt1aer" level="10" />
    341341                <field field_ref="sconcso4" level="10" />

  • LMDZ5/branches/testing/DefLists/file_def_histins_lmdz.xml

    r2839 r2845  
    337337                <field field_ref="od550aer" level="10" />
    338338                <field field_ref="od865aer" level="10" />
    339                 <field field_ref="absvisaer" level="10" />
     339                <field field_ref="abs550aer" level="10" />
    340340                <field field_ref="od550lt1aer" level="10" />
    341341                <field field_ref="sconcso4" level="10" />

  • LMDZ5/branches/testing/DefLists/file_def_histmth_lmdz.xml

    r2839 r2845  
    363363                <field field_ref="od550aer" level="2" />
    364364                <field field_ref="od865aer" level="2" />
    365                 <field field_ref="absvisaer" level="2" />
     365                <field field_ref="abs550aer" level="2" />
    366366                <field field_ref="od550lt1aer" level="2" />
    367367                <field field_ref="sconcso4" level="2" />

  • LMDZ5/branches/testing/DefLists/file_def_histstn_lmdz.xml

    r2839 r2845  
    337337                <field field_ref="od550aer" level="10" />
    338338                <field field_ref="od865aer" level="10" />
    339                 <field field_ref="absvisaer" level="10" />
     339                <field field_ref="abs550aer" level="10" />
    340340                <field field_ref="od550lt1aer" level="10" />
    341341                <field field_ref="sconcso4" level="10" />

  • LMDZ5/branches/testing/libf/phylmd/aeropt_2bands.F90

    r2641 r2845  
    1010  USE dimphy
    1111  USE aero_mod
    12   USE phys_local_var_mod, only: absvisaer
    1312  USE pres2lev_mod
    1413
    … …  
    11271126  ENDDO
    11281127
    1129   inu=1         ! visible waveband
    1130   mrfspecies=2  ! total aerosol AER     
    1131   DO i=1, KLON
    1132      absvisaer(i)=SUM((1-piz_allaer(i,:,mrfspecies,inu))*tau_allaer(i,:,mrfspecies,inu))
    1133   ENDDO
    1134 
    11351128  DEALLOCATE(aerosol_name)
    11361129

  • LMDZ5/branches/testing/libf/phylmd/phys_local_var_mod.F90

    r2839 r2845  
    167167      REAL, SAVE, ALLOCATABLE :: od550aer(:)
    168168      !$OMP THREADPRIVATE(od550aer)
    169       REAL, SAVE, ALLOCATABLE :: absvisaer(:)
    170       !$OMP THREADPRIVATE(absvisaer)
     169      REAL, SAVE, ALLOCATABLE :: abs550aer(:)
     170      !$OMP THREADPRIVATE(abs550aer)
    171171      REAL, SAVE, ALLOCATABLE :: od865aer(:)
    172172      !$OMP THREADPRIVATE(od865aer)
    … …  
    579579      allocate(od550aer(klon))
    580580      allocate(od865aer(klon))
    581       allocate(absvisaer(klon))
     581      allocate(abs550aer(klon))
    582582      allocate(ec550aer(klon,klev))
    583583      allocate(od550lt1aer(klon))
    … …  
    838838      deallocate(od550aer)
    839839      deallocate(od865aer)
    840       deallocate(absvisaer)
     840      deallocate(abs550aer)
    841841      deallocate(ec550aer)
    842842      deallocate(od550lt1aer)

  • LMDZ5/branches/testing/libf/phylmd/phys_output_ctrlout_mod.F90

    r2839 r2845  
    11001100  TYPE(ctrl_out), SAVE :: o_od865aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
    11011101    'od865aer', 'Total aerosol optical depth at 870nm', '-', (/ ('', i=1, 10) /))
    1102   TYPE(ctrl_out), SAVE :: o_absvisaer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
    1103     'absvisaer', 'Absorption aerosol visible optical depth', '-', (/ ('', i=1, 10) /))
     1102  TYPE(ctrl_out), SAVE :: o_abs550aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
     1103    'abs550aer', 'Absorption aerosol optical depth at 550nm', '-', (/ ('', i=1, 10) /))
    11041104  TYPE(ctrl_out), SAVE :: o_od550lt1aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
    11051105    'od550lt1aer', 'Fine mode optical depth', '-', (/ ('', i=1, 10) /))

  • LMDZ5/branches/testing/libf/phylmd/phys_output_write_mod.F90

    r2839 r2845  
    100100         o_solldown, o_dtsvdfo, o_dtsvdft, &
    101101         o_dtsvdfg, o_dtsvdfi, o_z0m, o_z0h, o_od443aer, o_od550aer, &
    102          o_od865aer, o_absvisaer, o_od550lt1aer, &
     102         o_od865aer, o_abs550aer, o_od550lt1aer, &
    103103         o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, &
    104104         o_sconcss, o_sconcdust, o_concso4, o_concno3, &
    … …  
    253253         pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, &
    254254         qsat2m, tpote, tpot, d_ts, od443aer, od550aer, &
    255          od865aer, absvisaer, od550lt1aer, sconcso4, sconcno3, &
     255         od865aer, abs550aer, od550lt1aer, sconcso4, sconcno3, &
    256256         sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, &
    257257         concoa, concbc, concss, concdust, loadso4, &
    … …  
    11731173             CALL histwrite_phy(o_od550aer, od550aer)
    11741174             CALL histwrite_phy(o_od865aer, od865aer)
    1175              CALL histwrite_phy(o_absvisaer, absvisaer)
     1175             CALL histwrite_phy(o_abs550aer, abs550aer)
    11761176             CALL histwrite_phy(o_od550lt1aer, od550lt1aer)
    11771177             CALL histwrite_phy(o_sconcso4, sconcso4)

  • LMDZ5/branches/testing/libf/phylmd/readaerosol.F90

    r2839 r2845  
    4242  REAL, POINTER, DIMENSION(:,:,:) :: pt_2
    4343  REAL, DIMENSION(klon,12)        :: psurf2, load2
    44   REAL                            :: p0           ! Reference pressure
    4544  INTEGER                         :: iyr1, iyr2, klev_src2
    4645  INTEGER                         :: it, k, i
    … …  
    5857     ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
    5958     ! pt_out has dimensions (klon, klev_src, 12)
    60      CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
     59     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
    6160     
    6261
    … …  
    6766     ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
    6867     ! pt_out has dimensions (klon, klev_src, 12)
    69      CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
     68     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
    7069     
    7170  ELSE IF (type == 'annuel') THEN
    … …  
    7675     ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month
    7776     ! pt_out has dimensions (klon, klev_src, 12)
    78      CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
     77     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
    7978     
    8079  ELSE IF (type == 'scenario') THEN
    … …  
    8685        ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
    8786        ! pt_out has dimensions (klon, klev_src, 12)
    88         CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
     87        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
    8988       
    9089     ELSE IF (iyr_in .GE. 2100) THEN
    … …  
    9392        ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
    9493        ! pt_out has dimensions (klon, klev_src, 12)
    95         CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
     94        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
    9695       
    9796     ELSE
    … …  
    113112        ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month
    114113        ! pt_out has dimensions (klon, klev_src, 12)
    115         CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
     114        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
    116115       
    117116        ! If to read two decades:
    … …  
    125124           ! get_aero_fromfile returns pt_2 allocated and initialized with data for 12 month
    126125           ! pt_2 has dimensions (klon, klev_src, 12)
    127            CALL get_aero_fromfile(name_aero, cyear, filename, klev_src2, pt_ap, pt_b, p0, pt_2, psurf2, load2)
     126           CALL get_aero_fromfile(name_aero, cyear, filename, klev_src2, pt_ap, pt_b, pt_2, psurf2, load2)
    128127           ! Test for same number of vertical levels
    129128           IF (klev_src /= klev_src2) THEN
    … …  
    168167
    169168
    170   SUBROUTINE get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, p0, pt_year, psurf_out, load_out)
     169  SUBROUTINE get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, pt_year, psurf_out, load_out)
    171170!****************************************************************************************
    172171! Read 12 month aerosol from file and distribute to local process on physical grid.
    … …  
    205204    REAL, POINTER, DIMENSION(:)           :: pt_ap        ! Pointer for describing the vertical levels     
    206205    REAL, POINTER, DIMENSION(:)           :: pt_b         ! Pointer for describing the vertical levels     
    207     REAL                                  :: p0           ! Reference pressure value
    208206    REAL, POINTER, DIMENSION(:,:,:)       :: pt_year      ! Pointer-variabale from file, 12 month, grid : klon,klev_src
    209207    REAL, DIMENSION(klon,12), INTENT(OUT) :: psurf_out    ! Surface pression for 12 months
    … …  
    292290       IF (ierr /= NF90_NOERR) THEN
    293291          ! Coordinate axe lev not found. Check for presnivs.
    294           ierr = nf90_inq_dimid(ncid, 'PRESNIVS', dimid)
     292          ierr = nf90_inq_dimid(ncid, 'presnivs', dimid)
    295293          IF (ierr /= NF90_NOERR) THEN
    296              ! Dimension PRESNIVS not found either
    297              CALL abort_physic('get_aero_fromfile', 'dimension lev or presnivs not in file',1)
    298           ELSE
    299              ! Old file found
    300              new_file=.FALSE.
    301              WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will not be done'
    302           END IF
     294             ierr = nf90_inq_dimid(ncid, 'PRESNIVS', dimid)
     295             IF (ierr /= NF90_NOERR) THEN
     296                ! Dimension PRESNIVS not found either
     297                CALL abort_physic('get_aero_fromfile', 'dimension lev,PRESNIVS or presnivs not in file',1)
     298             ELSE
     299                ! Old file found
     300                new_file=.FALSE.
     301                WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will not be done'
     302             END IF
     303          ELSE
     304             ! New file found
     305             new_file=.TRUE.
     306             WRITE(lunout,*) 'Vertical interpolation for ',TRIM(varname),' will be done'
     307          ENDIF
    303308       ELSE
    304309          ! New file found
    … …  
    328333!**************************************************************************************************
    329334       ierr = nf90_inq_dimid(ncid, 'TIME',dimid)
    330        CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps),"pb inq dim TIME" )
     335       if (ierr /= NF90_NOERR) THEN
     336          ierr = nf90_inq_dimid(ncid, 'time_counter', dimid)
     337       ENDIF
     338       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps),"pb inq dim TIME or time_counter" )
    331339!       IF (nbr_tsteps /= 12 .AND. nbr_tsteps /= 14) THEN
    332340       IF (nbr_tsteps /= 12 ) THEN
    … …  
    382390          CALL check_err( nf90_get_var(ncid, varid, pt_b),"pb get var b" )
    383391
    384 ! ++) Read p0 : reference pressure
    385 !****************************************************************************************
    386           ! Get variable id
    387           CALL check_err( nf90_inq_varid(ncid, "p0", varid),"pb inq var p0" )
    388           ! Get the variable
    389           CALL check_err( nf90_get_var(ncid, varid, p0),"pb get var p0" )
    390392         
    391393

  • LMDZ5/branches/testing/libf/phylmd/readaerosol_interp.F90

    r2542 r2845  
    162162     NULLIFY(pt_ap)
    163163     NULLIFY(pt_b)
    164   END IF
     164  ENDIF
    165165
    166166!****************************************************************************************
    … …  
    187187           filename='aerosols'
    188188           type='annuel'
    189         END IF
     189        ENDIF
    190190     ELSE  IF (aer_type == 'mix2') THEN
    191191        ! Special case using a mix of decenal sulfate file and natrual aerosols
    … …  
    196196           filename='aerosols'
    197197           type='preind'
    198         END IF
     198        ENDIF
    199199     ELSE  IF (aer_type == 'mix3') THEN
    200200        ! Special case using a mix of annual sulfate file and natrual aerosols
    … …  
    205205           filename='aerosols'
    206206           type='preind'
    207         END IF
     207        ENDIF
    208208     ELSE
    209209        CALL abort_physic('readaerosol_interp', 'this aer_type not supported',1)
    210      END IF
     210     ENDIF
    211211
    212212     CALL readaerosol(name_aero(id_aero), type, filename, iyr, klev_src, pt_ap, pt_b, pt_tmp, &
    … …  
    215215        ALLOCATE(var_year(klon, klev_src, 12, naero_spc), stat=ierr)
    216216        IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 5',1)
    217      END IF
     217     ENDIF
    218218     var_year(:,:,:,id_aero) = pt_tmp(:,:,:)
    219219
    … …  
    229229        WRITE(lunout,*) 'Aerosol : ', name_aero(id_aero)
    230230        CALL abort_physic('readaerosol_interp','Differnt vertical axes in aerosol forcing files',1)
    231      END IF
     231     ENDIF
    232232
    233233     IF (.NOT. ALLOCATED(pi_var_year)) THEN
    234234        ALLOCATE(pi_var_year(klon, klev_src, 12, naero_spc), stat=ierr)
    235235        IF (ierr /= 0) CALL abort_physic('readaerosol_interp', 'pb in allocation 6',1)
    236      END IF
     236     ENDIF
    237237     pi_var_year(:,:,:,id_aero) = pt_tmp(:,:,:)
    238238   
    … …  
    244244        CALL writefield_phy('load_year_src',load_year(:,:,id_aero),1)
    245245        CALL writefield_phy('pi_load_year_src',pi_load_year(:,:,id_aero),1)
    246      END IF
     246     ENDIF
    247247
    248248     ! Pointer no more useful, deallocate.
    … …  
    258258           WRITE(lunout,*) 'Warning! All forcing files for the same aerosol must have the same structure'
    259259           CALL abort_physic('readaerosol_interp', 'The aerosol files have not the same format',1)
    260         END IF
     260        ENDIF
    261261       
    262262        IF (klev /= klev_src) THEN
    263263           WRITE(lunout,*) 'Old format of aerosol file do not allowed vertical interpolation'
    264264           CALL abort_physic('readaerosol_interp', 'Old aerosol file not possible',1)
    265         END IF
     265        ENDIF
    266266
    267267     ELSE
    268268        vert_interp = .TRUE.
    269      END IF
     269     ENDIF
    270270
    271271!    Calendar initialisation
    … …  
    286286     endif
    287287
    288   END IF  ! IF ( (first .OR. iday==0) .AND. lnewday ) THEN
     288  ENDIF  ! IF ( (first .OR. iday==0) .AND. lnewday ) THEN
    289289 
    290290!****************************************************************************************
    … …  
    309309             ! the month is january, thus the month before december
    310310             im2=12
    311           END IF
     311          ENDIF
    312312       ELSE
    313313          ! the second half of the month
    … …  
    319319             im2=1
    320320          ENDIF
    321        END IF
     321       ENDIF
    322322     ELSE IF (nbr_tsteps == 14) then
    323323       im = im + 1
    … …  
    332332          day1 = month_mid(im)
    333333          day2 = month_mid(im2)
    334        END IF
     334       ENDIF
    335335     ELSE
    336336       CALL abort_physic('readaerosol_interp', 'number of months undefined',1)
    … …  
    358358                pi_var_year(i,k,im2,id_aero) - (jDay-day2)/(day1-day2) * &
    359359                (pi_var_year(i,k,im2,id_aero) - pi_var_year(i,k,im,id_aero))
    360         END DO
    361      END DO
     360        ENDDO
     361     ENDDO
    362362
    363363     ! Time interpolation for pressure at surface, still on vertical source grid
    … …  
    370370             pi_psurf_year(i,im2,id_aero) - (jDay-day2)/(day1-day2) * &
    371371             (pi_psurf_year(i,im2,id_aero) - pi_psurf_year(i,im,id_aero))
    372      END DO
     372     ENDDO
    373373
    374374     ! Time interpolation for the load, still on vertical source grid
    … …  
    381381             pi_load_year(i,im2,id_aero) - (jDay-day2)/(day1-day2) * &
    382382             (pi_load_year(i,im2,id_aero) - pi_load_year(i,im,id_aero))
    383      END DO
     383     ENDDO
    384384
    385385!****************************************************************************************
    … …  
    397397           DO i = 1, klon
    398398              pplay_src(i,k)= pt_ap(k) + pt_b(k)*psurf_day(i)
    399            END DO
    400         END DO
     399           ENDDO
     400        ENDDO
    401401       
    402402        IF (debug) THEN
    … …  
    406406           CALL writefield_phy('day_src',tmp1,klev_src)
    407407           CALL writefield_phy('pi_day_src',tmp2,klev_src)
    408         END IF
     408        ENDIF
    409409
    410410        ! b) vertical interpolation on pressure leveles
    … …  
    422422           DO i = 1, klon
    423423              delp(i,k) = paprs(i,k) - paprs (i,k+1)
    424            END DO
    425         END DO
     424           ENDDO
     425        ENDDO
    426426
    427427        ! Find the mass load in the actual pillar, on target grid
    … …  
    431431              zrho = pplay(i,k)/t_seri(i,k)/RD       ! [kg/m3]
    432432              volm = var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
    433               load_tgt(i) = load_tgt(i) + 1/RG * volm *delp(i,k)
    434            END DO
    435         END DO
     433              load_tgt(i) = load_tgt(i) + volm *delp(i,k)/RG
     434           ENDDO
     435        ENDDO
    436436       
    437437        ! Adjust, uniform
    438438        DO k = 1, klev
    439439           DO i = 1, klon
    440               var_day(i,k,id_aero) = var_day(i,k,id_aero)*load_src(i)/load_tgt(i)
    441            END DO
    442         END DO
     440              var_day(i,k,id_aero) = var_day(i,k,id_aero)*load_src(i)/max(1.e-30,load_tgt(i))
     441           ENDDO
     442        ENDDO
    443443       
    444444        IF (debug) THEN
    … …  
    448448                 zrho = pplay(i,k)/t_seri(i,k)/RD       ! [kg/m3]
    449449                 volm = var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
    450                  load_tgt_test(i) = load_tgt_test(i) + 1/RG * volm*delp(i,k)
    451               END DO
    452            END DO
     450                 load_tgt_test(i) = load_tgt_test(i) + volm*delp(i,k)/RG
     451              ENDDO
     452           ENDDO
    453453           
    454454           CALL writefield_phy('day_tgt2',var_day(:,:,id_aero),klev)
    … …  
    456456           CALL writefield_phy('load_tgt_test',load_tgt_test(:),1)
    457457           CALL writefield_phy('load_src',load_src(:),1)
    458         END IF
     458        ENDIF
    459459
    460460        ! - Interpolate variable tmp2 (source grid) to pi_var_day (target grid)
    … …  
    464464           DO i = 1, klon
    465465              pplay_src(i,k)= pt_ap(k) + pt_b(k)*pi_psurf_day(i)
    466            END DO
    467         END DO
     466           ENDDO
     467        ENDDO
    468468
    469469        IF (debug) THEN
    470470           CALL writefield_phy('pi_psurf_day_src',pi_psurf_day(:),1)
    471471           CALL writefield_phy('pi_pplay_src',pplay_src(:,:),klev_src)
    472         END IF
     472        ENDIF
    473473
    474474        ! b) vertical interpolation on pressure leveles
    … …  
    488488              zrho = pplay(i,k)/t_seri(i,k)/RD          ! [kg/m3]
    489489              volm = pi_var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
    490               load_tgt(i) = load_tgt(i) + 1/RG * volm * delp(i,k)
    491            END DO
    492         END DO
     490              load_tgt(i) = load_tgt(i) + volm*delp(i,k)/RG
     491           ENDDO
     492        ENDDO
    493493
    494494        DO k = 1, klev
    495495           DO i = 1, klon
    496               pi_var_day(i,k,id_aero) = pi_var_day(i,k,id_aero)*pi_load_src(i)/load_tgt(i)
    497            END DO
    498         END DO
     496              pi_var_day(i,k,id_aero) = pi_var_day(i,k,id_aero)*pi_load_src(i)/max(1.e-30,load_tgt(i))
     497           ENDDO
     498        ENDDO
    499499
    500500        IF (debug) THEN
    … …  
    504504                 zrho = pplay(i,k)/t_seri(i,k)/RD          ! [kg/m3]
    505505                 volm = pi_var_day(i,k,id_aero)*1.E-9/zrho ! [kg/kg]
    506                  load_tgt_test(i) = load_tgt_test(i) + 1/RG * volm * delp(i,k)
    507               END DO
    508            END DO
     506                 load_tgt_test(i) = load_tgt_test(i) + volm*delp(i,k)/RG
     507              ENDDO
     508           ENDDO
    509509           CALL writefield_phy('pi_day_tgt2',pi_var_day(:,:,id_aero),klev)
    510510           CALL writefield_phy('pi_load_tgt',load_tgt(:),1)
    511511           CALL writefield_phy('pi_load_tgt_test',load_tgt_test(:),1)
    512512           CALL writefield_phy('pi_load_src',pi_load_src(:),1)
    513         END IF
     513        ENDIF
    514514
    515515
    … …  
    519519        pi_var_day(:,:,id_aero) = tmp2(:,:)
    520520
    521      END IF ! vert_interp
     521     ENDIF ! vert_interp
    522522
    523523
    … …  
    539539                         trim(name_aero(id_aero)),'(i,k,im)=',           &
    540540                         var_year(i,k,im2,id_aero) - var_year(i,k,im,id_aero)
    541                  END IF
     541                 ENDIF
    542542                 WRITE(lunout,*) 'stop for aerosol : ',name_aero(id_aero)
    543543                 WRITE(lunout,*) 'day1, day2, jDay = ', day1, day2, jDay
    544544                 CALL abort_physic('readaerosol_interp','Error in interpolation 1',1)
    545               END IF
    546            END DO
    547         END DO
    548      END IF
     545              ENDIF
     546           ENDDO
     547        ENDDO
     548     ENDIF
    549549
    550550     IF (MINVAL(pi_var_day(:,:,id_aero)) < 0. ) THEN
    … …  
    558558                         trim(name_aero(id_aero)),'(i,k,im)=',           &
    559559                         pi_var_year(i,k,im2,id_aero) - pi_var_year(i,k,im,id_aero)
    560                  END IF
     560                 ENDIF
    561561                 
    562562                 WRITE(lunout,*) 'stop for aerosol : ',name_aero(id_aero)
    563563                 CALL abort_physic('readaerosol_interp','Error in interpolation 2',1)
    564               END IF
    565            END DO
    566         END DO
    567      END IF
    568 
    569   END IF ! lnewday
     564              ENDIF
     565           ENDDO
     566        ENDDO
     567     ENDIF
     568
     569  ENDIF ! lnewday
    570570
    571571!****************************************************************************************

  • LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90

    r2839 r2845  
    1212  USE DIMPHY
    1313  USE aero_mod
    14   USE phys_local_var_mod, ONLY: od443aer,od550aer,od865aer,ec550aer,od550lt1aer
     14  USE phys_local_var_mod, ONLY: od443aer,od550aer,od865aer,ec550aer,od550lt1aer,abs550aer
    1515  USE YOMCST, ONLY: RD,RG
    1616
    … …  
    6868  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum
    6969  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau
    70 
    7170  !
    7271  ! Local
    … …  
    9594  REAL :: delta(klon,klev), rh(klon,klev)
    9695  REAL :: tau_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
     96  REAL :: abs_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
    9797  REAL :: od670aer(klon)  ! epaisseur optique aerosol extinction 670 nm
    9898  REAL :: fac
    … …  
    104104 
    105105  REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! Ext. coeff. ** m2/g
     106  REAL :: abs_aers_5wv(nbre_RH,las,naero_soluble)     ! Abs. coeff. ** m2/g
    106107  REAL :: alpha_aeri_5wv(las,naero_insoluble)         ! Ext. coeff. ** m2/g
     108  REAL :: abs_aeri_5wv(las,naero_insoluble)           ! Abs. coeff. ** m2/g
    107109
    108110  !
    … …  
    117119  ! Geophys. Res. Atmos. Added by R. Wang and OB
    118120  REAL :: alpha_MG_5wv(nbre_RH,las,nbclassbc)
     121  REAL :: abs_MG_5wv(nbre_RH,las,nbclassbc)
    119122
    120123  !
    … …  
    191194   ! Nitrate insoluble
    192195  0.726, 0.753, 0.780, 0.797, 0.811 /
     196!
     197 DATA abs_aers_5wv/ &
     198   ! absorption BC Accumulation Soluble (AS)
     199  2.861, 2.861, 2.861, 2.861, 2.861, 3.089, 3.316, 3.767, 4.167, 4.211, 4.255, 4.647, &
     200  2.806, 2.806, 2.806, 2.806, 2.806, 3.010, 3.209, 3.597, 3.935, 3.971, 4.008, 4.333, &
     201  2.674, 2.674, 2.674, 2.674, 2.674, 2.847, 3.015, 3.335, 3.608, 3.638, 3.667, 3.924, &
     202  2.566, 2.566, 2.566, 2.566, 2.566, 2.723, 2.872, 3.155, 3.393, 3.419, 3.444, 3.667, &
     203  2.444, 2.444, 2.444, 2.444, 2.444, 2.585, 2.719, 2.968, 3.176, 3.199, 3.221, 3.413, &
     204   ! absorption POM Accumulation Soluble (AS)
     205  0.170, 0.170, 0.170, 0.170, 0.170, 0.167, 0.165, 0.162, 0.160, 0.160, 0.159, 0.158, &
     206  0.145, 0.145, 0.145, 0.145, 0.145, 0.143, 0.142, 0.139, 0.138, 0.138, 0.138, 0.137, &
     207  0.125, 0.125, 0.125, 0.125, 0.125, 0.123, 0.122, 0.120, 0.119, 0.119, 0.119, 0.119, &
     208  0.131, 0.131, 0.131, 0.131, 0.131, 0.130, 0.129, 0.127, 0.127, 0.127, 0.127, 0.127, &
     209  0.133, 0.133, 0.133, 0.133, 0.133, 0.132, 0.131, 0.131, 0.131, 0.131, 0.131, 0.131, &
     210  ! absorption Sulfate Coarse Soluble (CS)
     211  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     212  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     213  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     214  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     215  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     216   !-- Absorption Sulfate Accumulation (BC content=0)
     217  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     218  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     219  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     220  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     221  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     222   ! absorption Seasalt Super Coarse Soluble (SS)
     223  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     224  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     225  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     226  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     227  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     228   ! absorption Seasalt Coarse Soluble (CS)
     229  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     230  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     231  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     232  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     233  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     234   ! absorption Seasalt Accumulation Soluble (AS)
     235  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     236  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     237  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     238  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     239  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     240   ! absorption Nitrate Coarse Soluble (CS)
     241  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     242  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     243  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     244  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     245  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     246   ! absorption Nitrate Accumulation Soluble (AS)
     247  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     248  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     249  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     250  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, &
     251  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000  /
     252
     253 DATA abs_aeri_5wv/ &
     254   ! absorption Dust insoluble
     255  0.081, 0.048, 0.032, 0.027, 0.019, &
     256   ! absorption BC insoluble
     257  2.861, 2.806, 2.674, 2.566, 2.444, &
     258   ! absorption POM insoluble
     259  0.170, 0.145, 0.125, 0.131, 0.133, &
     260   ! absorption Nitrate insoluble
     261  0.000, 0.000, 0.000, 0.000, 0.000 /
    193262
    194263! Added by R. Wang (July 31 2016)
    … …  
    232301   4.505,  4.505,  4.505,  4.505,  4.520,  4.444,  4.356,  4.243,  4.089,  3.997,  3.912,  4.179, &
    233302   4.295,  4.295,  4.295,  4.295,  4.307,  4.239,  4.157,  4.045,  3.876,  3.757,  3.602,  3.569  /
     303!
     304   DATA abs_MG_5wv/ &
     305 !--BC content=0.001
     306  13.416, 13.416, 13.416, 13.416, 12.041, 11.928, 11.793, 11.680, 11.488, 11.367, 11.200, 10.968,&
     307  10.085, 10.085, 10.085, 10.085,  9.116,  9.061,  8.977,  8.901,  8.778, 8.712,  8.617,  8.474, &
     308   7.491,  7.491,  7.491,  7.491,  6.836,  6.808,  6.764,  6.719,  6.659, 6.613,  6.568,  6.508, &
     309   6.269,  6.269,  6.269,  6.269,  5.774,  5.761,  5.734,  5.706,  5.665, 5.637,  5.615,  5.579, &
     310   5.300,  5.300,  5.300,  5.300,  4.919,  4.913,  4.899,  4.882,  4.863, 4.847,  4.831,  4.825, &
     311 !--BC content=0.010
     312  12.829, 12.829, 12.829, 12.829, 11.692, 11.618, 11.523, 11.419, 11.278, 11.192, 11.055, 10.850,&
     313   9.766,  9.766,  9.766,  9.766,  8.932,  8.890,  8.828,  8.762,  8.671, 8.617,  8.528,  8.411, &
     314   7.316,  7.316,  7.316,  7.316,  6.739,  6.716,  6.684,  6.643,  6.597, 6.561,  6.517,  6.465, &
     315   6.154,  6.154,  6.154,  6.154,  5.708,  5.696,  5.676,  5.651,  5.624, 5.602,  5.576,  5.543, &
     316   5.216,  5.216,  5.216,  5.216,  4.874,  4.870,  4.860,  4.848,  4.835, 4.823,  4.810,  4.800, &
     317 !--BC content=0.020
     318  12.290, 12.290, 12.290, 12.290, 11.358, 11.315, 11.248, 11.175, 11.073, 11.008, 10.902, 10.743,&
     319   9.455,  9.455,  9.455,  9.455,  8.743,  8.716,  8.671,  8.622,  8.556, 8.513,  8.442,  8.349, &
     320   7.142,  7.142,  7.142,  7.142,  6.635,  6.621,  6.596,  6.567,  6.532, 6.503,  6.469,  6.428, &
     321   6.033,  6.033,  6.033,  6.033,  5.634,  5.629,  5.615,  5.598,  5.578, 5.561,  5.541,  5.517, &
     322   5.130,  5.130,  5.130,  5.130,  4.821,  4.821,  4.816,  4.809,  4.801, 4.794,  4.784,  4.781, &
     323 !--BC content=0.050
     324  10.989, 10.989, 10.989, 10.989, 10.504, 10.523, 10.528, 10.528, 10.522, 10.512, 10.485, 10.445,&
     325   8.671,  8.671,  8.671,  8.671,  8.239,  8.249,  8.248,  8.242,  8.233, 8.221,  8.199,  8.176, &
     326   6.688,  6.688,  6.688,  6.688,  6.346,  6.354,  6.353,  6.350,  6.346, 6.339,  6.328,  6.322, &
     327   5.707,  5.707,  5.707,  5.707,  5.427,  5.437,  5.440,  5.441,  5.444, 5.442,  5.438,  5.444, &
     328   4.894,  4.894,  4.894,  4.894,  4.671,  4.682,  4.688,  4.694,  4.702, 4.705,  4.709,  4.726, &
     329 !--BC content=0.100
     330   9.397,  9.397,  9.397,  9.397,  9.357,  9.443,  9.525,  9.615,  9.725, 9.788,  9.866,  9.991, &
     331   7.654,  7.654,  7.654,  7.654,  7.527,  7.581,  7.629,  7.682,  7.746, 7.781,  7.825,  7.901, &
     332   6.070,  6.070,  6.070,  6.070,  5.922,  5.956,  5.986,  6.018,  6.057, 6.079,  6.105,  6.156, &
     333   5.252,  5.252,  5.252,  5.252,  5.117,  5.146,  5.171,  5.198,  5.231, 5.250,  5.274,  5.322, &
     334   4.557,  4.557,  4.557,  4.557,  4.441,  4.466,  4.489,  4.513,  4.544, 4.562,  4.586,  4.634, &
     335 !--BC content=0.200
     336   7.300,  7.300,  7.300,  7.300,  7.649,  7.799,  7.960,  8.149,  8.397, 8.559,  8.779,  9.149, &
     337   6.225,  6.225,  6.225,  6.225,  6.403,  6.504,  6.610,  6.733,  6.893, 6.996,  7.136,  7.372, &
     338   5.145,  5.145,  5.145,  5.145,  5.216,  5.282,  5.350,  5.429,  5.530, 5.595,  5.682,  5.833, &
     339   4.550,  4.550,  4.550,  4.550,  4.587,  4.640,  4.694,  4.756,  4.836, 4.887,  4.957,  5.079, &
     340   4.023,  4.023,  4.023,  4.023,  4.041,  4.084,  4.128,  4.178,  4.244, 4.286,  4.344,  4.447  /
    234341  !
    235342  ! Initialisations
    … …  
    237344  tausum(:,:,:) = 0.
    238345  tau(:,:,:,:)=0.
     346
     347  abs550aer(:)=0.0
    239348
    240349  DO k=1, klev
    … …  
    396505             ENDIF
    397506
    398               tau_ae5wv_int = alpha_MG_5wv(RH_num(i,k),la,classbc)+DELTA(i,k)* &
    399                              (alpha_MG_5wv(RH_num(i,k)+1,la,classbc) - &
    400                               alpha_MG_5wv(RH_num(i,k),la,classbc))
    401               tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
    402               tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     507             tau_ae5wv_int = alpha_MG_5wv(RH_num(i,k),la,classbc)+DELTA(i,k)* &
     508                            (alpha_MG_5wv(RH_num(i,k)+1,la,classbc) - &
     509                             alpha_MG_5wv(RH_num(i,k),la,classbc))
     510             tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
     511             tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     512
     513             IF (la.EQ.la550) THEN
     514                abs_ae5wv_int = abs_MG_5wv(RH_num(i,k),la,classbc)+DELTA(i,k)* &
     515                               (abs_MG_5wv(RH_num(i,k)+1,la,classbc) - &
     516                                abs_MG_5wv(RH_num(i,k),la,classbc))
     517                abs550aer(i)=abs550aer(i)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*abs_ae5wv_int*fac
     518             ENDIF
     519
    403520            ENDDO
    404521          ENDDO
    … …  
    414531              tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
    415532              tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     533
     534              IF (la.EQ.la550) THEN
     535                 abs_ae5wv_int = abs_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
     536                                (abs_aers_5wv(RH_num(i,k)+1,la,spsol) - &
     537                                 abs_aers_5wv(RH_num(i,k),la,spsol))
     538                 abs550aer(i)=abs550aer(i)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*abs_ae5wv_int*fac
     539              ENDIF
     540
    416541            ENDDO
    417542          ENDDO
    … …  
    424549        DO k=1, klev
    425550          DO i=1, klon
     551
    426552            tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
    427553            tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
    428554            tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     555
     556            IF (la.EQ.la550) THEN
     557               abs_ae5wv_int = abs_aeri_5wv(la,spsol)
     558               abs550aer(i)=abs550aer(i)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*abs_ae5wv_int*fac
     559            ENDIF
     560
    429561          ENDDO
    430562        ENDDO

  • LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90

    r2839 r2845  
    1010  USE dimphy
    1111  USE aero_mod
    12   USE phys_local_var_mod, only: absvisaer
    1312  USE YOMCST, ONLY: RG
    1413
    … …  
    835834    ENDDO
    836835   
    837 !--waveband 2 and all aerosol (third index = 2)
    838   inu=2
    839   DO i=1, klon
    840      absvisaer(i)=SUM((1-piz_allaer(i,:,2,inu))*tau_allaer(i,:,2,inu))
    841   ENDDO
    842 
    843836  DEALLOCATE(aerosol_name)
    844837
Note: See TracChangeset for help on using the changeset viewer.