[38] | 1 | subroutine nlthermeq(ngrid, nlayer, pplev, pplay) |
---|
| 2 | c |
---|
[1047] | 3 | c Compute the number of layers nlaylte (stored in module yomlw_h) |
---|
[38] | 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 |
---|
[1047] | 10 | use yomlw_h, only: nlaylte |
---|
[38] | 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 |
---|
[2584] | 24 | |
---|
| 25 | !$OMP THREADPRIVATE(firstcall,igpmax) |
---|
| 26 | |
---|
[38] | 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. |
---|
[1775] | 35 | !! AS: can be problem w MESOSCALE nesting (ignored for the moment) |
---|
[38] | 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 |
---|