| 1 | subroutine nlthermeq(ngrid, nlayer, pplev, pplay) |
|---|
| 2 | c |
|---|
| 3 | c Compute the number of layers nlaylte (stored in module yomlw_h) |
|---|
| 4 | c over which local thermodynamic equilibrium |
|---|
| 5 | c radiation scheme should be run to be sure of covering at least to a |
|---|
| 6 | c height greater than (pressure lower than) p=pminte, set in nlteparams.h. |
|---|
| 7 | c The maximum layer needed is found for the worst possible case. |
|---|
| 8 | c Stephen Lewis 6/2000 |
|---|
| 9 | c Modified Y. Wanherdrick/ F. Forget 09/2000 |
|---|
| 10 | use yomlw_h, only: nlaylte |
|---|
| 11 | implicit none |
|---|
| 12 | #include "nlteparams.h" |
|---|
| 13 | #include "callkeys.h" |
|---|
| 14 | |
|---|
| 15 | c |
|---|
| 16 | c Input: |
|---|
| 17 | integer ngrid, nlayer |
|---|
| 18 | real pplev(ngrid, nlayer+1) |
|---|
| 19 | real pplay(ngrid, nlayer) |
|---|
| 20 | c |
|---|
| 21 | c Local: |
|---|
| 22 | integer igpmax, ismax |
|---|
| 23 | logical firstcall |
|---|
| 24 | |
|---|
| 25 | !$OMP THREADPRIVATE(firstcall,igpmax) |
|---|
| 26 | |
|---|
| 27 | data firstcall /.true./ |
|---|
| 28 | save firstcall, igpmax |
|---|
| 29 | c |
|---|
| 30 | if(firstcall) then |
|---|
| 31 | c Find the location of maximum surface pressure. |
|---|
| 32 | c Location won't vary much so only do it at the start; |
|---|
| 33 | c with no topography location would vary, but this is only |
|---|
| 34 | c needed for an estimate so any point would do in that case. |
|---|
| 35 | !! AS: can be problem w MESOSCALE nesting (ignored for the moment) |
|---|
| 36 | igpmax = ismax(ngrid, pplev, 1) |
|---|
| 37 | write(*, 10) ptrans |
|---|
| 38 | write(*, 20) zw |
|---|
| 39 | write(*, 30) pminte |
|---|
| 40 | firstcall = .false. |
|---|
| 41 | endif |
|---|
| 42 | c |
|---|
| 43 | IF(callnlte) then |
|---|
| 44 | c Find first layer above pminte at this location |
|---|
| 45 | do nlaylte = nlayer, 1, -1 |
|---|
| 46 | if (pplay(igpmax, nlaylte).gt.pminte) go to 100 |
|---|
| 47 | enddo |
|---|
| 48 | ELSE |
|---|
| 49 | nlaylte=nlayer |
|---|
| 50 | END IF |
|---|
| 51 | 100 write(*,*) 'LTE rad. calculations up to layer ', nlaylte |
|---|
| 52 | c |
|---|
| 53 | return |
|---|
| 54 | c |
|---|
| 55 | 10 format(' nlthermeq: transition to NLTE centred at ',f6.2,'Pa') |
|---|
| 56 | 20 format(' half-width (scale heights) ',f6.2) |
|---|
| 57 | 30 format(' suggested LTE coverage at least ',f6.2,'Pa') |
|---|
| 58 | end |
|---|
